;[I4-TENEX]<MFEXEC>XSUBRS.MAC;20268,  7-JAN-80 15:48:36, Ed: RLWSSD
;[I4-TENEX]<MFEXEC>XSUBRS.MAC;20269,  7-JAN-80 14:03:15, Ed: RLWSSD
;[I4-TENEX]<MFEXEC>XSUBRS.MAC;20268,  7-JAN-80 13:45:13, Ed: RLWSSD
; ADDED EXPANDED TABLE OF REASONS FOR SYSTEM SHUTDOWN (FOR DWNTIM)
;[I4-TENEX]<MFEXEC>XSUBRS.MAC;20267,  6-DEC-79 14:18:37, Ed: RLWSSD
; MINOR CHANGE TO ODTIM OUTPUT IN DWNTIM
;[I4-TENEX]<MFEXEC>XSUBRS.MAC;20266, 23-AUG-79 16:50:47, Ed: RLWSSD
; BUG FIX IN JSYTRP ROUTN.
;[I4-TENEX]<MFEXEC>XSUBRS.MAC;20265, 20-AUG-79 16:08:13, Ed: RLWSSD
; BUG FIX AT HUPSI+4: WAS TESTING "A" INSTEAD OF "Z" FOR LOGOFF FLAG.
;<MFEXEC>XSUBRS.MAC;20264     2-AUG-79 11:13:09    EDIT BY RLWSSD
; MORE FUN WITH TERMINAL INTERRUPTS.
;<MFEXEC>XSUBRS.MAC;20262    19-JUL-79 23:31:12    EDIT BY WEISSMAN
; ADDED TRAPPING/SIMULATION ROUTINES TO PREVENT A BACKGROUND FORK FROM
; RECEIVING TERMINAL INTERRUPTS (WHICH SURELY WEREN'T INTENDED FOR IT).
; THIS IS INSIDE A FEATUR %BAKTRP CONDITIONAL.
;<MFEXEC>XSUBRS.MAC;20261    19-JUL-79 15:48:22    EDIT BY WEISSMAN
;<MFEXEC>XSUBRS.MAC;20260    19-JUL-79 15:34:02    EDIT BY WEISSMAN
; BETTER REASON TYPING FOR SYSTEM DOWN MSGS.
;<MFEXEC>XSUBRS.MAC;20259    17-JUL-79 00:03:16    EDIT BY WEISSMAN
;<MFEXEC>XSUBRS.MAC;20258    16-JUL-79 23:16:56    EDIT BY WEISSMAN
; ADDED SUPER-FANCY LOWERCASE ROUTINE (IN FILE LOWER.MAC)
;<MFEXEC>XSUBRS.MAC;20257    13-JUL-79 11:23:11    EDIT BY WEISSMAN
;<MFEXEC>XSUBRS.MAC;20256    10-JUL-79 01:00:27    EDIT BY WEISSMAN
; FIXUP TO SPELLING CORRECTION (IN IACERR)
;<MFEXEC>XSUBRS.MAC;20255     3-JUL-79 14:46:32    EDIT BY WEISSMAN
;<MFEXEC>XSUBRS.MAC;20254    29-JUN-79 10:38:25    EDIT BY WEISSMAN
;<MFEXEC>XSUBRS.MAC;20253    29-JUN-79 10:11:49    EDIT BY WEISSMAN
;<MFEXEC>XSUBRS.MAC;20252    28-JUN-79 15:36:58    EDIT BY WEISSMAN
; ADDED SPELLING CORRECTION STUFF
; ADDED JSYS TRAPPING LOGIC FOR BACKGROUND FORKS
;<MFEXEC>XSUBRS.MAC;20201  17-OCT-78 16:44:23  EDIT BY B-SMITH
;Make $DELCH fail if echo is turned off
;<MFEXEC>XSUBRS.MAC;20200  26-SEP-78 17:13:02  EDIT BY B-SMITH
;Finish Partial keyword help, RELPAG, some bug fixes
;2.02
;<MFEXEC>XSUBRS.MAC;20102   2-JAN-78 15:46:53  EDIT BY B-SMITH
;<MFEXEC>XSUBRS.MAC;20101  29-DEC-77 17:02:38  EDIT BY B-SMITH
;2.01
;added free space management subroutines
;<MFEXEC>XSUBRS.MAC;20000  18-MAR-77 15:38:14  EDIT BY B-SMITH
;2.00
	TITLE SUBRS
	SEARCH STENEX,XSTG

	SALL

;SUBROUTINES TO PRINT READY CHARACTER: "@" NORMALLY, 

READY::	PUSH P,A
	PUSH P,B
	MOVE A,COJFN
	RFPOS
	TRNN B,-1		;AT LEFT MARGIN?
	JRST READY3		;YES
	MOVEI B,CR		;NO, TYPE CRLF FIRST
	BOUT
	MOVEI B,LF
	BOUT
	JRST READY3

READY2::CALL READY		;PRINT 2 READY CHRS FOR SUBCOMMANDS
	PUSH P,A		;PRINT ONE READY CHARACTER
	PUSH P,B
	MOVE A,COJFN
READY3:
	HRRZ B,HERALD		;NOT ENABLED HERALD
	SKIPE PRVENF		;BUT IF ENABLED,
	HLRZ B,HERALD		;USE THE ENABLED HERALD
	BOUT
	POP P,B
	POP P,A
	RET

;%KEYW
;KEYWORD INPUT AND LOOKUP UUO SERVICE ROUTINE ("KEYWD" UUO)

;DOES EDITING, TABLE LOOKUP, RECOGNITION.
;DEFAULTS: ON NULL INPUT, OR WITHOUT INPUT IF LAST TERMINATOR = EOL,
;	OR IF DASH AND TERMINATOR INPUT
;
;USAGE:
;	SET FLAGS BAKFF,PUNCF,NEOLF IF DESIRED
;	 (SEE COMMENTS IN FILE XDEF.MAC)
;	KEYWD TABLE
;	0 OR XWD [VALUE],[ASCIZ @TEXT@] FOR DEFAULT VALUE
;	R1: NOT IN TABLE, OR NULL INPUT WITH NO DEFAULT IN CALL.
;	    "BAKFF" IS SET SO SAME INPUT IS USED ON NEXT CALL.
;       R2: FOUND, "VALUE" IN "KWV"
;   ON EITHER RETURN, TERMINATOR IS IN "TRM" AND "CHR",
;   DESCRIPTIVE BITS FOR TERMINATOR IN "CBT"
;   TEXT IS APPENDED TO "CBUF", "BFP" IS END BYTE PTR, ".BFP", BEG.
;   PUNCF AND NEOLF ARE CLEARED
;   EOLNEF SET IF AN EOL WAS INPUT AND WAS NOT ECHOED
;
;GOES DIRECTLY TO "CERR" ON BAD CHARACTER, TOO LONG, AMBIGUOUS, ETC
;ACCEPTABLE CHARACTERS ARE LETTERS AND DIGITS ONLY UNLESS "PUNCF" ON.
; ("-" ALSO ACCEPTED MERELY TO SIMPLIFY CODING DEFAULT ON "-" IN INPUT.)
;TERMINATORS: ALT MODE, SPACE, COMMA IF "COMOK" ON IN VALUE (OW_CERR),
;EOL OR SEMICOLON IF "EOLOK" ON IN VALUE,
;LEFT PAREN IF "LPROK" ON IN VALUE,
;"<" IF "LANOK" ON IN VALUE (SPECIAL TREATMENT DESCRIBED BELOW).
;
;DEFAULTING: ON ALT MODE DEFAULT TEXT IS TYPED; GOOD RETURN IS GIVEN
;	AS THOUGH DEFAULT TEXT HAD BEEN INPUT.
;
;BACKUP: IF "BAKFF" IS SET AT ENTRY, PREVIOUS INPUT STRING IS RE-USED.
;
;GLITCH NOTE: IF LAST TERMINATOR IS EOL OR SEMICOLON,
;	DEFAULTS WITHOUT INPUT, SO OPTIONAL FIELDS
;	AT END OF COMMAND ARE AUTOMATICALLY DEFAULTED.  
;	BUT THIS DOESN'T HAPPEN IF BAKFF IS SET (EXTERNALLY). ALSO THIS
;	MEANS "TEOL" BIT IN AC "CBT" MUST BE OFF
;	AT FIRST CALL ON A NEW LINE.
;
;TABLE FORM:
;       TABLE:  NUMBER OF ENTRIES
;               XWD [VALUE],[ASCIZ @TEXT@]  FOR EACH ENTRY, ALPH ORDER
;		;"VALUE" HAS BITS IN LEFT HALF (SOME INTERPRETED HERE),
;		;	USUALLY DISPATCH ADDRESS IN RIGHT HALF
;		;WORD AFTER [VALUE] HAS PRIVILEGES IF B17 ON IN VALUE

%KEYW::	PUSH P,D
	PUSH P,C
	PUSH P,B
	PUSH P,A
	PUSH P,40
	TLNE Z,BAKFF
	JRST .+3
	TRNE CBT,TEOL		;LAST TERMINATOR=EOL OR SEMICOLON?
	JRST [	SKIPN D,@-5(P)	;YES, DEFAULT ARGUMENT GIVEN?
		JRST .+1
		JRST CWRD2]	;YES, GO DEFAULT WITHOUT INPUTTING
;INPUT.  "INHELP" MACRO INPUTS A FIELD (WITH CSTR), DOING EDITING &
;RE-USING PREVIOUS INPUT IF "BAKFF" ON, AND TYPES MESSAGE IF "?" INPUT.
;%Z TYPES ALL KEYWORDS IN TABLE.  CSTR HANDLES NEOLF AND EOLNEF.
	MOVE A,0(P)		;TABLE ADDRES FOR %Z
	INHELP <One of the following:
%1Z>;
;LEFT-JUSTIFY AND ZERO-FILL THE STRING IN CWBUF BECAUSE "FSYM"
; REQUIRES IT THAT WAY.
	SETZM CWBUF
	MOVE A,[CWBUF,,CWBUF+1]
	BLT A,CWBUF+SYMLTH-1	;CLEAR BUFFER AREA
	CAILE CNT,5*SYMLTH-1	;WILL IT FIT BUFFER
	ERROR <Word too long>
	MOVE B,.BFP		;BEGINNING OF STRING
	MOVEI C,-1(CNT)		;REDUCE COUNT BY ONE TO OMIT TERMINATOR
	JUMPG C,CWRD3		;JUMP IF NON-NULL INPUT
	CAIN TRM,"?"
	JRST [	CALL UBP
		MOVE A,0(P)
		ETYPE < One of the following:
%1Z%%Y>
		JRST MORE]
	SKIPN D,@-5(P)		;PICK UP WORD AFTER CALL
	JRST CWRD8		;NO DEFAULT SPECIFIED IN CALL
CWRD2:	MOVEI C,@-5(P)
	CALL PRVCK
	 JRST CERR
	HLRZ C,D		;PRETEND WE RETURNED FROM FSYM: [VALUE],
	HRLI D,<POINT 7,0,-1>B53 ;.. BYTE POINTER TO TEXT
	JRST CWRD4		;USE CODE FOR "UNIQUE SUBSET" MATCH
CWRD3:  MOVE D,[POINT 7,CWBUF,-1]
CWRD3A:	ILDB A,B        	;COPY LOOP
	CAIL A,141		;ASCII LOWER CASE A
	CAILE A,172		;ASCII LOWER CASE Z
	JRST .+2		;NOT A LOWER CASE LETTER
	SUBI A,40		;CONVERT LOWER CASE TO UPPER
	IDPB A,D
	SOJG C,CWRD3A
	CAIN TRM,"?"
	JRST PARHLP
		;CHECK THAT FIELD TERMINATOR IS LEGAL
	ALLOW TEOL+TSPC+TALT+TCOM+TLPR+TLAN
	CAIN CNT,2		;CHECK FOR "-": 1 CHAR+TERMINATOR?
	JRST [	CAIN A,"-"	;YES, WAS THAT CHARACTER "-"?
		SKIPN D,@-5(P)	;YES, PICK UP WORD AFTER CALL
		JRST .+1	;NOT "-" OR NO DEFAULT PTR AFTER CALL
		HLRZ C,D	;PRETEND WE GOT EXACT MATCH RETURN...
		JRST CWRD5]	;...FROM FSYM: [VALUE] IN C

;%KEYW...
;LOOK IT UP
	MOVE A,(P)		;POINTER THAT CAME IN 40
	MOVEI B,CWBUF		;LOCATION OF TEXT 
	CALL FSYM		;SEARCH TABLE (A) FOR TEXT (B). 4 RETURNS.
;R1: NO MATCH AT ALL. GIVE BAD RETURN WITH "BAKFF" SET.
	 JRST CWRD8
;R2: AMBIGUOUS PARTIAL MATCH. ALLOW MORE INPUT IF ALT MODE.
	JRST [	CAIE CHR,ALTM
		JRST CERR	;TERMINATOR NOT ALT MODE
		CALL DING	;RING BELL, STOP NON-INTERACTIVE JOB,
				;CLEAR TTY INPUT BUFFER.
		CALL UBP	;GET RID OF ALT MODE IN BUFFER
		JRST MORE]	;GET MORE INPUT, RETN WHERE CSTR DID 
;R3: UNIQUE PARTIAL MATCH. TYPE REST ON ALT MODE.
;ALSO, DEFAULT COMES HERE W TEXT PTR TO ENTIRE TEXT
CWRD4:	JRST [	CAIE CHR,ALTM
		JRST .+1	;NOT ALT MODE, OK AS IS.
		CALL UBP	;BACK UP
		TLO Z,STCF 	;SAY "STORE PRINTED CHARACTERS"
		MOVE A,D	;POINTER TO REST RETURNED BY "FSYM"
		CALL CTYPE	;PRINT AND ALSO STORE STRING
		TLZ Z,STCF
		JRST CWRD6]	;PRIVILEGES ARE ALREADY CHECKED.
;R4: PERFECT MATCH.
;ALSO, "-" INPUT DEFAULT COMES HERE

CWRD5:
CWRD6:	MOVE KWV,(C)		;VALUE WORD. "FSYM" RETURNED PTR TO IT.
	TLNN KWV,NSPALT		;THIS BIT SAYS DON'T...
	ALTYPE ( )		;TYPE SPACE AFTER WORD TERMINATED WITH ALT MODE.

;%KEYW...
;WORD HAS BEEN FOUND IN TABLE.
;CHECK CERTAIN TERMINATORS VS CERTAIN FLAGS.
	TRNE CBT,TCOM
	 JRST [	TLNN KWV,COMOK
		JRST CERR
		JRST .+1]
	TRNE CBT,TLPR
	 JRST [	TLNN KWV,LPROK
		JRST CERR
		JRST .+1]
	TRNE CBT,TEOL
	 JRST [	TLNN KWV,EOLOK+ONEWD		;ONEWD IMPLIES EOLOK
		JRST CERR
		JRST .+1]
	TRNE CBT,TLAN
	 JRST [	TLNN KWV,LANOK
		JRST CERR
		;SPECIAL HANDLING OF "<" TERMINATOR, VALID ONLY IN
		;CONTEXTS WHERE IT IS REALLY THE BEGINNING OF THE
		;THE NEXT FIELD: SET UP BAKFF, CNT, .BFP SO
		;THAT NEXT CSTR WILL RETURN 1-CHAR STRING "<".
		;VALUES OF CNT AND .BFP FOR CURRENT KEYWORD ARE LOST.
		MOVE .BFP,BFP
		CALL UBP		;UNINCREMENTS BFP
		EXCH .BFP,BFP
		MOVEI CNT,1
		TLO Z,BAKFF
		JRST .+1]
;EXIT
	AOSA -5(P)		;SKIP
CWRD8:	TLO Z,BAKFF		;ON BAD RETURN SET "BACK UP FIELD" FLAG
	AOS -5(P)		;GET PAST DEFAULT ARGUMENT WORD
	POP P,40
	POP P,A
	POP P,B
	POP P,C
	POP P,D
	RET

PARHLP:	MOVE A,(P)		;Table
	MOVEI B,CWBUF		;Text
	CALL FSYM
	 JRST [	TYPE < No match>
		JRST PARHL1]
	 JFCL			;Ambigious, give table
	 JFCL			;Unique partial
	 			;Exact match

	ETYPE < One of the following:
>
	HRRZ A,0(P)		;Table
	ADD A,(A)		;Compute last entry
	PUSH P,C
	PUSH P,D
	PUSH P,E
	PUSH P,F
	PUSH P,G
	MOVE C,B		;Index into table
	CALL TSCAN
	POP P,G
	POP P,F
	POP P,E
	POP P,D
	POP P,C
PARHL1:	CALL UBP
	ETYPE <%Y>
	JRST MORE

;TSCAN - Type out partial help strings
; A/ Last table entry address
; C/ Pointer to entry to start scan
; CWBUF/ Text to compare

TSCAN:	CAILE C,(A)		;Check for beyond end of table
	RET
	CALL PRVCK		;Check if command allowed
	 AOJA C,TSCAN		;No.
	HLRZ E,(C)		;Pointer to value
	MOVE D,(E)		;Value
	TLNE D,INVIS		;Forget it if invisible
	AOJA C,TSCAN
	MOVEI B,CWBUF
	MOVE E,(C)		;Get table entry
TSCAN2:	MOVE D,(B)
	LSH D,-1
	ADDI B,1
	MOVE F,(E)
	LSH F,-1
	CAMN F,D
	JRST [	TRNE D,177	;At end?
		AOJA E,TSCAN2	;No
		JRST TSCAN3]
	TRNE D,177		;Last word of input?
	RET			;No, can't be partial match
	HRLZI G,-4
	TDNE D,[-1		;Find out how many bytes if D are 0
		1777777777
		7777777
		37777
		177 ] (G)	;Yes, (G).
	AOBJN G,.-1
	ANDCM F,@.-2		;Clear F's trailing bytes
	CAME F,D		;Are they the same
	RET			;No, all done
TSCAN3:	MOVE B,(C)
	CALL COMSPC		;Space to column
	UTYPE (B)
	AOJA C,TSCAN

;PRVCK
;SUBROUTINE TO CHECK SPECIAL CAPABILITIES THIS USER HAS AGAINST THOSE
; IN PRIVILEGE WORD OF KEYWORD ENTRY
;SKIPS IF SPECIFIED CAPABILITIES REQUIRED FOR COMMAND ARE ALLOWED.
;
;USES:	CHECKED ON EXACT MATCH IN FSYM AND WHEN TESTING FOR AMBIGUITY
; ;IN SBST (ALSO USED IN %Z FOR LIMITING HELP!)

PRVCK:	SKIPE NOCKPV		;FLAG TO MAKE THIS ROUTINE A SKIPA
	 JRST [ AOS 0(P)
		RET]
	PUSH P,D
	PUSH P,C
	HLRZ C,(C)
	MOVE D,(C)
	SKIPG CUSRNO		;USER LOGGED IN?
	TLNE D,NOLOG		;NO.  THIS COMMAND OK?
	CAIA			;COMMAND OK (SO FAR)
	JRST PRVCK9		;FAIL
	SKIPE SECURE		;SECURE ENVIRONMENT?
	TLNE D,SECOK		;YES. IS COMMAND OK?
	 AOSA -2(P)		;NOT SECURE OR OK, ASSUME OK
	JRST PRVCK9		;FAIL
	TLNE D,1		;IS THERE A PRIVILEGE WORD?
	SKIPN D,1(C)		;YES BUT VALID  ONLY IF NON-ZERO
	JRST PRVCK9		;COMMAND OK WITHOUT CHECK
	PUSH P,B
	PUSH P,A
	TLZE D,(ENAREQ)
	SKIPE PRVENF
	SKIPA C,PSPRIV
	JRST PRVCK7		;NOT ENABLED!!
	HLR C,D
	TLNE C,(C)		;AT LEAST ONE MATCH?
	JRST PRVCK8		;YES.  CAN EXECUTE THIS COMMAND
	MOVEI A,.FHSLF 		;NO.  TRY GETTING ACCESS FROM MONITOR
	RPCAP
	TRNN B,(D)		;AVAILABLE?
PRVCK7:	SOS -4(P)		;NOT AVAILABLE -- DON'T SKIP
PRVCK8:	POP P,A
	POP P,B
PRVCK9:	POP P,C
	POP P,D
	RET

;FSYM - SYMBOL TABLE LOOKUP SUBROUTINE USED IN %KEYW (PRECEDING)

;SYMBOL TABLE LOOKUP SUBROUTINE

;TAKES:	A: POINTER TO TABLE
;	B: WORD POINTER TO INPUT STRING TO SEARCH FOR. MUST BE LEFT
;	   ADJUSTED, NULL TERMINATED, LAST WD FILLED W NULLS.
;	CALL FSYM
;RETURNS: +1: NO MATCH AT ALL
;	    B: POINTER TO FIRST ENTRY .GE. TEST ENTRY
;	+2: INPUT IS AMBIGUOUS -- IT IS INITIAL SUBSTRING OF MORE
;	    THAN ONE TABLE ENTRY'S TEXT
;	    B: AS IN +1 (Pointer to first entry .GE. test entry)
;	+3: INPUT IS INITIAL SUBSTRING OF A UNIQUE TABLE ENTRY
;	    D: BYTE POINTER TO REST OF THAT ENTRY'S TEXT
;	    C: "VALUE" FROM THAT TABEL ENTRY IN RH
;	    B: AS IN +1
;	+4: INPUT EXACTLY MATCHES A TABLE ENTRY
;	    C: AS FOR +3
;	    B: AS FOR +3
;NOTE: THE VALUE RETURNED IN B IS TO BE USED FOR INSERTING AND
;	DELETING.  THEREFORE THE VALUE RETURN AND THE STRING POINTER
;	RETURNED ARE CORRECT (ALONG WITH THE RETURN LOCATION) FOR
;	EXECUTION BUT THE VALUE IN B IS ALWAYS THE SMALLEST ENTRY
;	GREATER OR EQUAL TO THE INPUT (TEST STRING).
;	AC'S UNCHANGED EXCEPT AS INDICATED. HOWEVER, TO CHECK THE
;	TABLE TO BE SURE THE NEW ENTRY IS NOT IN THE TABLE, THE
;	PRIVILEGES CHECK MAY PREVENT THE FINDING OF THIS ENTRY.
;	THEREFORE, WHEN SCANNING THE TABLE TO DETERMINE IF A SYMBOL
;	IS IN USE, THE CALLING ROUTINE SHOULD DISABLE PRVCK BY SETING
;	NOCKPV (SETOM NOCKPV).

;TABLE FORM:
; LABEL: NUMBER OF ENTRIES
;	 XWD VALUE,[ASCIZ /TEXT/] PER ENTRY
;	   .
;	   .
; ENTRIES MUST BE ALPHABETICALLY ORDERED ON ASCII COLLATING SEQUENCE
;  (AS OPPOSED TO ALGEBRAICALLY ORDERED ON 36-BIT WORD VALUES)

;AC USE
;   A	POINTS AT LAST ENTRY IN TABLE
;   B   POINTER WHICH IS INDEXED THRU INPUT TEXT
;   C   POINTER INTO TABLE
;   D   WORD OF INPUT TEXT
;   E   POINTER WHICH IS INDEXED THROUGH THE TEXT OF A TABLE ENTRY
;   F   WORD OF TEXT FROM TABLE ENTRY
;   G   "DELTA" - THE BINARY SEARCH INCREMENT

 IFN E-D-1,<BARF>		;E=D+1 IS ASSUMED

;FSYM ENTRY

FSYM::	PUSH P,A		;SAVE AC'S
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,E
	PUSH P,F
	PUSH P,G

	HRRZ A,-6(P)
;INIT DELTA TO HIGHEST POWER OF 2 IN TABLE LENGTH
	MOVE D,(A)		;TABLE LENGTH
	JFFO D,FSYM1
	MOVEI	C,1(A)		;FIRST AVAILABLE ENTRY
	MOVEM	C,-5(P)		;RETURN IN B
	JRST	NOMAT		;0 LENGTH: NO MATCH
FSYM1:
	MOVEI G,1
	MOVN E,E
	LSH G,43(E)		;SHIFT BY 35 - # OF 0 BITS TO GET POWER

	MOVEI C,(A)		;INIT POINTER THAT RUNS OVER TABLE
	ADD A,(A)		;LOCATION OF LAST USED ENTRY IN TABLE

;FSYM...

; BINARY SEARCH. STOPS AT = ENTRY OR SMALLEST > ENTRY.

FSRC1:	ADDI C,(G)		;ADD DELTA TO TABLE POINTER
FSRC1A:	LSH G,-1		;HALVE DELTA FOR NEXT TIME AROUND
	CAILE C,(A)
	JRST FSRC4		;POINTS BEYOND END OF TABLE, GO BACK UP.
;COMPARE THE INPUT TEXT TO A TEXT IN THE TABLE
	MOVE B,-5(P)		;GET PTR TO INPUT TEXT SUPPLIED IN B
	MOVE E,(C)		;POINTER INTO TABLE TEXT FROM TABLE WORD
FSRC2:	MOVE D,(B)		;GET AN INPUT WORD
	LSH D,-1		;POSITION SO DATA ISN'T IN SIGN BIT
	MOVEI B,1(B)		;INDEX INPUT POINTER
	MOVE F,(E)		;GET A WORD OF TABLE TEXT
	LSH F,-1
	CAMGE F,D
	JRST FSRC3		;TABLE ENTRY LESS THAN INPUT
	CAME F,D
	JRST FSRC4		;TABLE ENTRY GREATER THAN INPUT 
	TRNE D,177		;THESE WORDS EQUAL, AT END OF INPUT?
	AOJA E,FSRC2		;NO, INDEX TABLE TEXT PTR, CONT. COMPARE
	PUSH	P,C		;FOR RETURN IN B
	CALL	PRVCK
	AOJA	C,NEM2		;CHECK NEXT ENTRY
	POP	P,-6(P)		;RETURN IN B

;MATCH FOUND.
;CODE FOR EXITS, SEARCH STUFF CONTINUES AFTER THIS.
	AOS -7(P)		;INCREMENT RETURN ADDRESS
UPAR:	AOS -7(P)
	HLRZ D,(C)		;VALUE FIELD FROM ENTRY WHICH MATCHED
	MOVEM D,-4(P)		;RETURN SAME IN C
APAR:
	AOS -7(P)
NOMAT:
	POP P,G		;RESTORE AC'S
	POP P,F
	POP P,E
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET		;RETURN

;THE TEXT OF THIS TABLE ENTRY IS LESS THAN INPUT STRING

FSRC3:	JUMPN G,FSRC1		;DELTA><0, MOVE DOWN AND CONTINUE SEARCH
	AOJA C,NEM1		;DONE SEARCH. NEXT ENTRY IN TABLE IS THE
		;SMALLEST LARGER ENTRY. IF THERE IS NO NEXT ENTRY, THEN
		;THERE IS NO MATCH. "SBST" SUBR IS CODED TO HANDLE THIS 

;THIS TABLE ENTRY GREATER THAN INPUT, OR POINTER IS OF END OF TABLE

FSRC4:	SUBI C,(G)		;MOVE UP IN TABLE
	JUMPN G,FSRC1A		;UNLESS DELTA=0, CONTINUE SEARCH.

;FSYM...

;WE GET TO "NEM1" WHEN THE SEARCH COMPLETES WITHOUT FINDING AN EXACT
;MATCH.  C POINTS TO SMALLEST TABLE ENTRY GREATER THAN INPUT.
;THIS ENTRY MAY OR MAY NOT BE A SUBSET MATCH; IF IT IS, THEN IT IS 
;AMBIGUOUS IF AND ONLY IF THERE EXISTS ANOTHER SUBSET MATCH.
;NOTE:	IF THIS IS ELIMINATED BY PRIVILEGES, THEN THE NEXT ENTRY IS
;	TAKEN AND TESTED FOR A MATCH.

NEM1:
	PUSH	P,C		;SAVE FIRST POINTER (RETURNED IN B)
NEM2:
	PUSH	P,C
	PUSH	P,E
	CALL	SBST
	JRST	[SUB	P,BHC+2
		POP	P,-6(P)	;B
		JRST	NOMAT]
	MOVEM	C,-1(P)	;SAVE C
	MOVEM	E,0(P)		;LIKEWISE E
	ADDI	C,1		;LOOK AT NEXT ENTRY
	CALL	SBST
	JRST	[POP	P,-6(P)	;RETURN THIS IN D
		POP	P,C	; AND TABLE ENTRY IN C
		POP	P,-6(P)	;B
		JRST	UPAR]
	SUB	P,BHC+2	;AMBIGUOUS SUBSET OF COMMAND
	POP	P,-6(P)		;B
	JRST	APAR

;SUBROUTINE SBST FOR FSYM

;SUBSET TEST SUBROUTINE FOR "FSYM".
;COMPARES INPUT STRING AND STRING FOR TABLE ENTRY C POINTS TO,
; SKIPS IF FORMER IS INITIAL SUBSTRING OF LATTER.
;ON R2, RETURNS IN E A BYTE POINTER TO REST OF TABLE ENTRY STRING
;MUST BE CALLED ONLY WHEN INPUT STRING IS LESS THAN TABLE STRING
;SEE "FSYM"'S COMMENTS ON AC USE. CLOBBERS B,D,E,F,G.

SBST:	CAILE C,(A)		;C BEYOND END OF TABLE?
	RET			;YES, NO ENTRY, INPUT ISN'T SUBSET, RETURN.
	CALL PRVCK		;IF PRIVILEGES BAD ON THIS COMMAND,
	 AOJA C,SBST		; THEN TRY THE NEXT ONE!
;FIND FIRST WORD OF STRINGS IN WHICH THEY DIFFER
	MOVE B,-11(P)		;POINTER TO INPUT TEXT
	MOVE E,(C)		;POINTER TO TABLE ENTRY'S TEXT
SBST1:	MOVE D,(B)		;WORD OF INPUT
	LSH D,-1		;POSITION FOR COMPARE
	MOVEI B,1(B)		;INDEX INPUT POINTER
	MOVE F,(E)		;WORD OF TABLE ENTRY
	LSH F,-1		;POSITION
	CAMGE F,D		;REMOVE AFTER DEBUGGING
	 CALL SCREWUP		;.. GO TO EXEC'S PROGRAM ERROR ROUTINE
	CAMG F,D
	AOJA E,SBST1		;IF ITS = IT MUST NOT BE END.
	TRNE D,177		;IS DIFFERENCE IN LAST WORD OF INPUT?
	RET		;NO, INPUT CAN'T BE SUBSTRING OF TABLE ENTRY.
;MASK OFF TABLE TEXT TO LENGTH OF INPUT
	HRLZI G,-4
	TDNE D,[-1		;LOOP TO SEE HOW MANY BYTES OF D ARE 0
		1777777777
		7777777
		37777
		177 ] (G)	;YES, (G).
	AOBJN G,.-1
	ANDCM F,@.-2		;THIS CLEARS F WHERE THERE ARE BITS IN TABLE
;CONVERT WORD PTR IN E TO BYTE POINTER AS REQUIRED ON R2.
	HLL E,[	POINT 7,0,-1
		POINT 7,0,6
		POINT 7,0,13
		POINT 7,0,20
		POINT 7,0,27] (G)
;NOW IF MASKED PART OF TABLE WORD = INPUT WORD, INPUT IS SUBSET.
	CAMN F,D
	AOS (P)		;SKIP
	RET

;%NOI
;NOISE WORD UUO SERVICE ROUTINE ("NOISE" MACRO)
;
;ARGUMENT IS AN ASCIZ TEXT
;IF LAST TERMINATOR IS ALT MODE, TYPE " (<GIVEN TEXT>) ".
;IF SPACE, COMMA, OR COLON, PASS FOLLOWING PARENTHESIZED TEXT (IF ANY), 
;  REQUIRING THAT INPUT BE A PROPERLY ORDERED SUBSET OF GIVEN.
;  AN ALT MODE IN PARENTHESIZED TEXT CAUSES REST OF GIVEN TO BE OUTPUT,
;     AND "TRM" TO BE SET TO ALT MODE.
;IF !, SPECIAL BEHAVIOR FOR LOGIN COMMAND:  TYPE " (<GIVEN TEXT>) ",
;  THEN ALSO PASS PARENTHESIZED TEXT, IF ANY, AS AFTER SPACE (IN CASE
;  A COMMAND FILE, MIMICING A TYPESCRIPT, CONTAINS THE TEXT).
;IF LEFT PAREN, SIMILARLY PASS TEXT TO ) OR ALT MODE.
;OTHER TERMINATORS  PRODUCE NO ACTION.
;
;CAVEAT: IF TRM IS SPACE OR COMMA AND THERE IS NO (TEXT),
;	%NOI HAS READ AHEAD ONE INPUT FIELD (AND SET BAKFF). SO DON'T
;	TRY TO OUTPUT ANYTHING BETWEEN CALL TO %NOI AND NEXT INPUT.

%NOI::	PUSH P,40		;SAVE ARGUMENT ADDRESS
	TRNE CBT,TLPR
	JRST NOI0
	CAIE TRM,"!"
	TRNE CBT,TALT
	;FOR ALT MODE OR ! TYPE GIVEN TEXT
	JRST       [U$TYPE [ASCIZ /(/]
		POP P,40
		PUSH P,40		;KEEP IT IN PD ALSO
		U$TYPE @40
		U$TYPE [ASCIZ /) /]
		CAIE TRM,"!"
		JRST [	POP P,40
			RET]
		;THE FOLLOWING IS JUST LIKE "JRST NOIA"
		;EXCEPT ECHOING, IF OFF, IS NOT TURNED ON.
		TLO Z,NEOLF
		CALL CSTR
		CAIN TRM,"("
		CAILE CNT,1
		JRST [	TLO Z,BAKFF
			JRST [	POP P,40
				RET]]
		JRST NOI0A]
	TRNN CBT,TSPC+TCOM+TCOL		;SPACE, TAB, COMMA, OR COLON?
	JRST [	POP P,40	;OTHER TERMINATORS IGNORED
		RET]

;%NOI...
;SPACE AND COMMA GET HERE
;PASS UP (TEXT), WHERE TEXT IS ANY SUBSET OF GIVEN IN ORIGINAL ORDER,
;WITH ANY NUMBER OF ADDED SPACES.

;FIRST WE MUST SEE IF NEXT CHARACTER IS "(". BEFORE DOING THIS, WE
;MUST INPUT AN ENTIRE FIELD, TO MAKE EDITING CHARACTERS WORK
;RIGHT (CONSIDER THE CASE WHERE USER TYPES LETTER, BAKSLASH,  "(" ).

NOIA:	TLO Z,NEOLF		;DON'T ECHO EOLS - FIELD MAY BE A FILE NAME
	CALL CSTR		;INPUT A FIELD
	CAIN TRM,"("		;WAS INPUT "(",
	CAILE CNT,1		;WITH NOTHING BEFORE IT?
	JRST [	TLO Z,BAKFF		;NO "(". BACK OUT AND RETURN.
		;UNECHOED EOL WILL BE ECHOED IF APPROPRIATE AT NEXT
		;"CSTR" OR AT "CONF"
		JRST [	POP P,40
			RET]]
	TLNE Z,NECHOF		;ECHOING OFF (PASSWORD) ?
	PRINT (TRM)		;YES, PRINT THE "(".
;INPUT CHARACTERS TILL ) OR ALT MODE.
;CAN'T PROCESS DURING INPUT BECAUSE OF EDITING.
; ( AS LAST TERMINATOR COMES HERE

NOI0:	TLNE Z,NECHOF		;ECHOING OFF?
	CALL DOECHO		;YES, PUT IT ON SO NOISE WORD IS ECHOED
NOI0A:	CALL CSTR		;INPUT TILL ANY TERMINATOR
	TRNE CBT,TRPR+TALT		; ) OR ALT MODE?
	JRST NOI1
	TRNE CBT,TSPC		;SPACE OR TAB?
	JRST MORE		;AFTER SPACE GET MORE (RETURNS TO .-4)
	JRST CERR		;EOL, SEMICOLON, COMMA, ETC ILLEGAL HERE.

;%NOI...
;MATCH LOOP: INPUT CHAR IS OK IF IT MATCHES A CHARACTER IN GIVEN
;STRING AFTER LAST ONE MATCHED. IGNORE SPACES IN BOTH STRINGS.

NOI1:	EXCH A,(P)		;SAVE A, GET POINTER TO GIVEN.
	PUSH P,B
	PUSH P,C
	PUSH P,D
	HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE PTR TO GIVEN
	MOVE C,.BFP		;BYTE PTR TO INPUT
IGNOI2:	ILDB D,C		;GET AN INPUT CHARACTER
	CAIL D,141		;ASCII LOWER CASE A
	CAILE D,172		;ASCII LOWER CASE Z
	JRST .+2		;NOT A LOWER CASE LETTER
	SUBI D,40		;CONVERT LOWER CASE TO UPPER
	CAIE D,TAB
	CAIN D," "
	JRST IGNOI2
	CAIN D,")"
		; RIGHT PAREN TERMINATES LOOP
IGNOI1:	JRST [	POP P,D		;EXIT
		POP P,C
		POP P,B
		POP P,A
		RET ]
	CAIN D,ALTM
		;ON ALT MODE TERMINATION, PRINT REST OF GIVEN AND ).
	JRST [	CALL UBP	;BACK UP BFP TO UNBUFFER ALT MODE
		TLO Z,STCF	;SAY APPEND PRINTED CHARS TO CWBUF
		CALL CTYPE	;PRINT REST OF GIVEN (A POINTS TO IT)
		UTYPE [ASCIZ /) /]		;ADD ) AND SPACE TO IT
		TLZ Z,STCF
		JRST IGNOI1]	;EXIT 
IGNOI3:	ILDB B,A		;GET A GIVEN CHARACTER
	CAIL B,141		;LOWER CASE A
	CAILE B,172		;LOWER CASE Z
	CAIA			;NOT A LOWER CASE LETTER
	 SUBI B,40		;GIVE IT A RAISE
	CAIN B," "
	JRST IGNOI3
	JUMPE B,CERR		;MATCH FAILS IF GIVEN ENDS BEFORE INPUT
	CAME B,D		;MATCH?
	JRST IGNOI3		;NO, TRY NEXT GIVEN ON SAME INPUT CHAR
	JRST IGNOI2		;YES, GO TO NEXT CHAR IN BOTH STRINGS

;SBCOM UUO
;INPUT AND DISPATCH ON SUBCOMMANDS, USING TABLE EFFECTIVE ADDR POINTS TO
;TERMINATES ON NULL SUBCOMMAND OR ONE WITH 0 DISPATCH ADDRESS
;USES INCLUDE DIRECTORY, COPY, PRINT, CREATE, TYPE/LIST

%SBCOM::PUSH P,CERET
	PUSH P,.P
	PUSH P,.JBUFP
	PUSH P,KWV1
	PUSH P,E
	PUSH P,40
SBCOM1:	MOVEI A,SBCOM1
	MOVEM A,CERET		;SAY COME BACK HERE AFTER PRINTING ERROR MESSAGE
	MOVEM P,.P		;PD LEVEL TO RESTORE AFTER ERROR
	MOVE A,JBUFP
	MOVEM A,.JBUFP		;JFN STACK LEVEL TO BE RESTORED AFTER ERROR
	MOVE BFP,[POINT 7,CBUF,-1]		;COMMAND STRING BUFFER POINTER
	CALL READY2		;TYPE 2 READY CHARACTERS: @@ OR !!
	SETZB TRM,CBT		;CLEAR TERMINATOR AND BITS: EOL HERE WOULD
		;MAKE "KEYWD" DEFAULT THO IT SHOULDN'T.
	TLZ Z,BAKFF+PUNCF+NEOLF+EOLNEF+DASHF
		;AN OBSCURE CASE IN "DIRECTORY" LEAVES NEOLF ON,
		;WHICH TURNS EOLNEF ON IN CONFIRM, WHICH SCREWS UP
		;FOLLOWING "KEYWD".
	KEYWD @(P)		;INPUT A KEYWORD AND LOOK UP IN CALLER'S TABLE
	 T <>,,ONEWD,SBCOM9		;NULL DEFAULTS TO THIS.
	 JRST CERR		;ERROR IF NOT FOUND IN TABLE
	TLZ Z,F1		;REQUIRED BY SOME COMMANDS, EG "CREATE".
	MOVE KWV1,KWV		;SAVE KEYWORD'S BITS FOR "CONFIRM" ETC
	TLNE KWV1,ONEWD		;IF "ONE WORD COMMAND" BIT ON,
	CONFIRM		;CONFIRM BEFORE DISPATCH
	MOVE E,-1(P)		;PRESERVE E FOR "CREATE"
		;(I DON'T THINK IT CAN GET CLOBBERED ANYWAY)
	TRNN KWV1,-1
	CALL SBCOM9		;0 DISPATCH ADDRESS MEANS TERMINATE SUBCOMMANDS
	CALL (KWV1)		;CALL CALLER'S ROUTINE FOR THIS SUBCOMMAND
	MOVEM E,-1(P)
	JRST SBCOM1		;GO GET ANOTHER

;TERMINATING SUBCOMMAND INPUT

SBCOM9:	SUB P,[XWD 2,2]		;FORGET SUBCOMMAND RETURN AND 40
	POP P,E
	POP P,KWV1
	POP P,.JBUFP
	POP P,.P
	POP P,CERET
	RET

;UINHEL UUO (INHELP MACRO)
;INPUT STRING WITH CSTR (NEXT). IF STRING CONSISTS OF "?" ONLY,
; OR ? AND A TERMINATOR, "ETYPE" THE MESSAGE THE EFFECTIVE ADDRESS
;POINTS TO, RETYPE COMMAND LINE SO FAR, AND INPUT ANOTHER STRING.

%INHEL::PUSH P,A
	PUSH P,40
	CALL CSTR
	CAILE CNT,2
	JRST UINHE9		;TOO LONG
	MOVE A,.BFP
	ILDB A,A		;FIRST CHARACTER
	CAIE A,"?"
	JRST UINHE9		;NOT "?"
	MOVE BFP,.BFP		;DISCARD "?" STRING
	PRINT " "
	MOVE A,-1(P)		;CALLER'S A FOR ETYPE
	UETYPE @(P)		;GIVEN MESSAGE
	CAMN BFP,[POINT 7,CBUF,-1]		;AFTER NULL COMMAND,
	U.$ERR 0		;USE ERROR CODE TO RESTORE P, RETYPE READY
		;CHARACTERS, RESTART COMMAND.  U.$ERR DOESN'T
		;CLEAR INBUF, 0 MEANS NO MESSAGE. NOTE THAT
		;AT LEAST THE FIRST FEW AC'S AREN'T RESTORED.
	ETYPE (%Y)		;RETYPE INPUT LINE
	CALL CSTR		;INPUT ANOTHER STRING
;EXIT: FIX THINGS UP SO "MORE" CAN BE USED AS AFTER A CALL
; DIRECTLY TO "CSTR".

UINHE9:	SUB P,[XWD 1,1]		;FORGET 40
	POP P,A
	POP P,CSTRR		;STORE RETURN FOR USE BY "MORE"
	JRST @CSTRR

;CSTR AND MORE
;INPUT A FIELD SUBROUTINE (CSTR),
;AND APPEND TO FIELD REENTRY POINT (MORE).
;FIELD CONSISTS OF 0 OR MORE CHARACTERS CONSISTING OF
;   LETTERS AND DIGITS, AND ALSO PUNCTUATION IF "PUNCF" IS ON.
;   "-" IS ACCEPTED IN FIELD TO SIMPLIFY CODING "-" FOR NULL FIELD.
;ANY OTHER CHARACTER IS FIELD TERMINATOR.
;FLAG "BAKFF" CAUSES PREVIOUSLY INPUT FIELD TO BE USED AGAIN.
;   CAVEAT: EXACTLY THE SAME FIELD IS AGAIN RETURNED IF "PUNCF"
;	   WAS ON AND HAS BEEN TURNED OFF.
;	   NO KNOWN CASES WHERE THIS MATTERS. 3/4/70
;FLAG "NEOLF" SUPPRESSES EOL ECHOING.  THIS IS USED WHEN A FILE
;	NAME IS BEING INPUT, BECAUSE "GTJFN" PRINTS EOL WHERE
;	APPROPRIATE EVEN IF EOL IS IN STRING NOT ON FILE.
;
;ACCEPTS: "BFP": POINTER TO CURRENT END OF COMMAND STRING
;   "MORE" ALSO REQUIRES THAT .BFP, CNT, CHR, TRM, AND CBT
;	         HAVEN'T BEEN CLOBBERED.
;RETURNS: "BFP": NEW END
;         ".BFP": BEGINNING = OLD END
;         "CNT": # OF CHARACTERS IN FIELD
;            (USED BY ^A AND ^W SO MUST BE PRESERVED IF "MORE" IS USED)
;         "TRM" AND "CHR": TERMINATING CHARACTER
;	  "CBT": CHRTBL WORD FOR TERMINATING CHAR -- DESCRIPTIVE BITS
;		SUCH AS "TEOL", "OCTDIG", ETC.
;	  FLAGS BAKFF, PUNCF, NEOLF CLEAR
;	  FLAG EOLNEF SET IF UNECHOED EOL INPUT
;
;"MORE" DOESN'T INITIALIZE .BFP AND CNT.
;"MORE" RETURNS TO WHERE "CSTR" WAS LAST CALLED FROM. 
;     BEWARE OF PD LEVEL BEING DIFFERENT!

;CSTR AND MORE...
;BEGIN NEW FIELD ENTRY

CSTR::	POP P,CSTRR		;SO "MORE" RETURNS SAME PLACE
	TLNE Z,NEOLF		;SUPPRESSION OF EOL ECHOING REQUESTED?
		;THIS FEATURE IS USED WHEN READING A STRING TO
		;BE FED TO GTJFN, WHICH PRINTS THE EOL ITSELF.
	JRST [	CALL NOECEO		;YES, CHANGE CCOC SO EOL'S NOT PRINTED
		JRST CSTR0]
	TLZE Z,EOLNEF		;NO. ECHO PREVIOUSLY UNECHOED EOL FROM PRECEDING
	PRINT EOL		;FIELD OR FROM THIS FIELD IF BAKFF ON.
CSTR0:	TLZE Z,BAKFF		;TEST AND CLEAR "RE-USE SAME FIELD" FLAG
		;RE-USE SAME FIELD: CHECK LAST TERMINATOR AGAIN, TO
		;MAKE IT READ MORE IN THE CASE WHERE "PUNCF" WAS OFF AND NOW
		;IS ON. THIS CAN HAPPEN IN FILE NAME COLLECTION.
	JRST CSTR2		;(USUALLY JUST EXITS.)
	CALL NALNBK		;SET BREAK SET TO NON-ALPHANUMERICS
CSTR1:	MOVE .BFP,BFP		;BEGIN A NEW INPUT FIELD TO PREVENT
	SETZ CNT,		;...EDITING.
	CALL CCHRI		;INPUT A CHARACTER, STORE, PROCESS EDIT CHARS
CSTR2:	TLNE Z,CTRLVF		;IF PRECEDED BY ^V,
	JUMPN CHR,CSTR3		;ANY CHAR BUT NULL IS PART OF FIELD.
	TRNN CBT,ALPHAN		;IS IT ALPHANUMERIC (INCLUDES "-")?
	JRST CSTR5		;NO.
CSTR3:	CALL CCHRI		;YES, INPUT AND STORE NEXT CHARACTER.
	JRST CSTR2
;HAVE A NON-ALPHANUMERIC CHARACTER

CSTR5:	TLNE Z,PUNCF		;ARE WE ALLOWING PUNCTUATION IN FIELD?
	TRNN CBT,PUNBIT		;YES, IS IT A PUNCTUATION CHARACTER?
	JRST .+2
	JRST CSTR3

;CSTR AND MORE...
;HAVE PROBABLE TERMINATOR.
;BUT IF ITS SPACE OR TAB AND CNT=1, THEN ITS A LEADING CHARACTER THAT
;   MUST BE IGNORED.
;LEADING CHARACTERS MUST BE IGNOZED HERE, NOT IN A LOOP AT BEGINNING
;   OF FIELD INPUT, TO HANDLE CASE WHERE TYPIST DELETES ENTIRE
;   FIELD WITH EDITING CHARACTERS, THEN TYPES A SPACE OR TAB.
	CAIG CNT,1		;ANY CHARS BEFORE IT?
	JRST [	TRNE CBT,TSPC		;IS IT A SPACE, TAB, OR & ?
		JRST CSTR1		;YES, IGNORE IT.
		JRST .+1]		;NO, IT TERMINATES FIELD.
;REALLY HAVE TERMINATOR
	MOVE TRM,CHR
	PUSH P,A
	PUSH P,B
	SETZ A,
	MOVE B,BFP
	IDPB A,B		;STORE 0 AFTER STRING. NEEDED FOR FILE NAMES.
	POP P,B
	POP P,A
CSTR9:	TLZ Z,PUNCF		;CLEAR "PUNCTUATION CHARACTERS ALLOWED" FLAG
	TLZE Z,NEOLF		;CLEAR "DON'T ECHO EOLS" FLAG
	CALL DOECEO		;AND CHANGE CCOC SO EOLS WILL PRINT
	PUSH P,CSTRR		;RETURN
	RET

;ENTRY TO ADD MORE CHARACTERS TO SAME FIELD AND RETURN TO WHERE "CSTR"
;WAS CALLED.
MORE=:CSTR3

;PASCOM
;SUBROUTINE TO PASS COMMENT, IF ANY.
;IF TRM=;, IGNORE INPUT TO EOL.
;DO IT BY FIELDS FOR CONSISTENT BEHAVIOR OF EDITING CHARACTERS.
;BUT LEAVE AC'S SET FOR PRECEDING FIELD.

PASCOM::TRNN Z,CTRLVF		;I'VE FORGOTTEN WHY ^V; DOESN'T COUNT
	CAIE TRM,";"
	RET		;NO COMMENT
	PUSH P,.BFP
	PUSH P,CNT
	PUSH P,CHR
PASCM1:	CALL CSTR
	CAIE	TRM,FORMF
	CAIN	TRM,EOL
	JRST	.+2
	JRST	PASCM1
	PUSH	P,A
	PUSH	P,B
	MOVE	A,[POINT 7,CBUF]
	ILDB	B,A
	CAIE	B,";"
	JRST	PASCM2
	ILDB	B,A
	CAIN	B,";"
	JRST	GOBBLE		;START PERMANENT (!) COMMENT MODE
PASCM2:	POP	P,B
	POP	P,A
	POP P,CHR
	POP P,CNT
	POP P,.BFP
	RET

GOBBLE:				;PERMANENT (!) COMMENT MODE
SRI <	MOVE	A,['TALK  ']
	SETNM			;TELL EVERYONE WE'RE TALKING
>
	CALL	DOECEO		;ECHO EOLS
	CALL	ALLBK		;EVERYTHING BREAKS
	CALL	CRIF
	MOVE	BFP,[POINT 7,CBUF]
	SETZ	CNT,
	$TYPE	<; >
GOBBL1:	CALL	CSTR
	CAIE	TRM,EOL
	CAIN	TRM,FORMF
	JRST	GOBBLE
	CAIE	TRM,"Z"-100
	JRST	GOBBL1		;NOT ^Z SO GO AROUND AGAIN
	SUB	P,[5,,5]	;RESTORE STACK
	MOVEI	TRM,EOL
	MOVE CBT,CHRTBL##(TRM)	;LOOKS LIKE EOL TO ME!
	RET

;SERVICE ROUTINE FOR "ALLOW" UUO.
;CHECKS THAT LAST CHARACTER (USUALLY FIELD TERMINATOR) IS AS
;DESCRIBED BY BITS IN EFFECTIVE ADDRESS.
;IE MAKES SURE E OR'D WITH C(CBT) >< 0.

%ALLOW::TRNN CBT,@40
	JRST CERR
	RET

;CONF
;CONFIRMATION AND COMMAND TERMINATION SUBROUTINE
;ALL COMMANDS, EVEN NON-CONFIRMATION ONES, SHOULD CALL THIS.

;USES KWV1,TRM AND DOES THE FOLLOWING:
; IF PROGX, THE THING (BEING RUN?) GETS THE REST OF THE COMMAND LINE
;  SO NO SCANNING FOR EOL'S ETC. IS PERMITTED.
; IF BAKFF ON, ERROR UNLESS CNT=1.
; IF TRM=; , INPUT CHARS TO EOL AND EXIT.
; IF NOCONF ON, TYPE EOL UNLESS TRM=EOL OR FORMFEED AND EXIT.
; IF TRM><EOL OR IF CONMAN ON, INPUT CHARACTERS TILL NON-SPACE.
; BUT IF BAKFF ON, FALL THRU WITHOUT INPUTTING CHARACTERS.
;   IF EOL, EXIT.
;   IF ; , INPUT CHARS TILL EOL AND EXIT.
;   IF ALT MODE AND "ALTCON" ON, TYPE CR AND EXIT.
;   ELSE ERROR: TYPE " ? " AND LET USER TRY AGAIN.
;   ANY CHARACTER PRECEDED BY ^V GETS ERROR TREATMENT

CONF::	TLZE Z,EOLNEF		;IS THERE AN UNECHOED EOL?
	PRINT EOL		;YES, ECHO IT NOW
	TLNE KWV1,PROGX		;PASSING CONTROL TO A PROGRAM?
	 RET			;YES. IT GETS THE REST OF LINE
	TLNN KWV1,CONFRC
	JRST CONF2

;FORCED CONFIRMATION FOR CERTAIN COMMANDS: 
;ALWAYS TYPE "[CONFIRM:]" ON NEXT LINE AND REQUIRE EOL.
	CALL PASCOM		;CHEW UP COMMENT IF ANY (PRESERVES TRM)
	CAIN TRM,";"
	MOVEI TRM,EOL		;DONT INPUT COMMENT AGAIN AT "CONF7".
	TRNN CBT,TEOL		;NEED WE "RFPOS" HERE?
	PRINT EOL		;IF CARRIAGE ISN'T AT LEFT, PUT IT THERE
CONF2::		; ... CAUSES "[CONFIRM:]" TO BE TYPED BELOW.
;IF THERE IS A FIELD WHICH HAS BEEN INPUT BUT NOT USED, IT MUST BE NULL.
;(SUCH A FIELD CAN OCCUR IF COMMAND ENDS IN A NOISE WORD AND THE
; USER TERMINATES WITH SPACE AND OMITS THE NOISE, BUT POSSIBLY
; TYPES SOME OTHER GARBAGE.)
	TLNE Z,BAKFF		;UNUSED INPUT FIELD?
	JRST [	CAILE CNT,1
		JRST CERR	;NON-NULL, USER TYPED GARBAGE
		JRST .+1]
	CAIN TRM,";"
	JRST CONF7         	; ; AS LAST FIELD TERMINATOR.
	TLNE KWV1,NOCONF
	JRST [	TRNN CBT,TEOL
		PRINT EOL
		RET]
	MOVE CHR,TRM       	;(SHOULD BE THERE ANYWAY)
	TLNN KWV1,CONMAN+CONFRC	;FLAGS SAY ALWAYS CONFIRM
	TRNN CBT,TEOL		;A CR ALWAYS ENDS THE CMND IF CONMAN OFF
	TLNE Z,BAKFF		;IF, UNUSED FIELD USE ITS TERMINATOR
	JRST CONF8

;CONF...
;READ A CHARACTER TO CONFIRM COMMAND.
;FIRST TYPE " [CONFIRM:] " IF AT LEFT MARGIN. SHOULD ONLY HAPPEN IF
; CONMAN ON AND USER ENDED LAST FIELD WITH CR AND COMMAND
; DIDN'T JUST TYPE OLD FILE/NEW FILE.
	PUSH P,A
	PUSH P,B
	MOVE A,COJFN
	RFPOS			;READ FILE POSITION
	TLZ B,-1
	CAIG B,2
	TYPE < [Confirm] >
	POP P,B
	POP P,A
	CALL ALLBK		;SET BREAK SET TO ALL CHARACTERS
CONF6:	MOVE .BFP,BFP		;NEW FIELD PREVENTS INVALID EDITING
	SETZ CNT,		;...
	CALL CCHRI		;INPUT CHARACTER
	TRNE CBT,TSPC
	JRST CONF6		;IGNORE PRECEDING SPACES AND TABS
	MOVE TRM,CHR
CONF7:	CALL PASCOM		;IF ;, IGNORE CHARACTERS TIL EOL

CONF8:	TLNE Z,CTRLVF
	JRST CONFE		;^V ALWAYS LOOSES
	TRNE CBT,TEOL		;EOL OR ; OR FORMFEED
	JRST CONF9		;SUCCESS
	CAIN CHR,ALTM
	JRST [	TLNN KWV1,ALTCON	;ALT MODE. OK AS TERMINATOR?
		JRST CONFE		;NO, TYPE " ? " AND RETRY
		PRINT EOL
		JRST CONF9]
	JRST CONFE

;CONFIRMATION SUCCESSFUL

CONF9:	TLZ Z,BAKFF		;REALLY MATTERS, EG, FOR "^E PRINT"
	RET

;CONFIRMATION FAILURE
;ON "?" TYPE EXPLANATORY MESSAGE, RETYPE COMMAND, ALLOW RETRY

CONFE:	CAIG CNT,1
	CAIE CHR,"?"
	JRST CONFE1		;NOT "?"
	MOVE BFP,.BFP		;REMOVE THE "?" FROM THE COMMAND LINE
	ETYPE < Confirm with carriage return%Y>; %Y RETYPES COMMAND
	JRST CONF6		;GO INPUT CONFIRMATION CHARACTER AGAIN
CONFE1:	TYPE < ? >		;KEEP TRYING TILL HE TYPES ^X OR ^C.
	BTCHER			;STOP NON-CONVERSATIONAL JOB
	MOVE BFP,.BFP		;FORGET BAD CONFIRMATION CHAR (FOR ^R)
	JRST CONF6		;GO TRY AGAIN

;TCONF
;CONFIRMATION ROUTINE (LIKE CONF) INTENDED TO BE USED DURING COMMAND
;EXECUTION.  DIFFERS FROM CONF IN THAT IT IS TRANSPARENT TO MOST AC'S
;AND HAS SEPARATE CONFIRMATION AND NON-CONFIRMATION RETURNS.

;	CALL TCONF
;	RET +1:	NOT CONFIRMED (I.E. ^X OR RUBOUT)
;	RET +2:	CONFIRMED (CR, EOL, ETC.)

;NOTE THIS ROUTINE PROBABLY OUGHT TO BE IMPLEMENTED AS A SPECIAL CALL
;TO CONF, BUT HTAT REQUIRES SAVING INCREDIBLE AMOUNTS OF STATE
;(INCLUDING THE CONTENTS OF CSBUF!)

TCONF::	CALL DOECEO		;ENSURE CR WILL ECHO
	CALL ALLBK		;BREAK ON ALL TYPED IN CHARACTERS
	PUSH P,EOFDSP		;CALLER (LIST) MIGHT HAVE ITS OWN TRAP
	MOVEI A,CCHEOF		;ROUTINE TO HANDLE EOF
	MOVEM A,EOFDSP
TCONF1:	MOVE A,CIJFN
	CFIBF			;FLUSH TYPEAHEAD TO AVOID CONFUSION
	BIN			;GET CONFIRMATION CHARACTER
	CAIN B,177
	 JRST TCONFR		;RUBOUT
	CAIN B,"X"-100
	 JRST TCONFX		;^X
	CAIN B,15		;CR, EXPECT TO SEE LF AFTER SO READ IT
	 BIN
	CAIE B,37
	CAIN B,12
	 JRST TCONFC		;EOL OR LF, CONFIRMATION
	TYPE < ? >		;SOMETHING ELSE, KEEP TRYING UNTIL
	JRST TCONF1		;USER TYPES EOL OR RUBOUT

TCONFC:	AOSA -1(P)		;HERE FOR CONFIRMATION EXIT
TCONFX:	TYPE <^X
>
	POP P,EOFDSP		;RESTORE PREVIOUS EOF DISPATCH
	RET

TCONFR:	TYPE <XXX
>
	POP P,EOFDSP		;RESTORE PREVIOUS EOF DISPATCH
	RET

;SPRTR
;TEST TERMINATOR (SEPARATOR) AND MAYBE READ AND TEST THE NEXT FIELD,
; TO DETERMINE WHETHER THERE'S A COMMA NEXT (R2), THE END OF THE
; COMMAND (R3), OR GARBAGE OR ANOTHER ARG WITHOUT A COMMA (R1).
;
;TYPICAL USES: AFTER "DIRECTORY" OR "TYPE", TO SEE IF THERE IS
; A COMMA TO INITIATE SUBCOMMAND INPUT, OR A FILE NAME ARG (NOT
; SEPARATED WITH COMMA), OR NEITHER; BETWEEN ARGS IN A LIST
; SEPARATED WITH COMMAS, AS IN SOME SUBCOMMANDS OF "CREATE".
;
;IN MORE DETAIL:
;  RETURN +1:
;    ALT MODE OR SPACE NOT FOLLOWED IMMEDIATELY BY COMMA, EOL, OR
;    ALT MODE, IE FOLLOWED BY SOME OTHER TERMINATOR, OR AN
;    ALPHANUMERIC FIELD.  BAKFF SET, READY TO PROCESS FIELD.
;
;  RETURN +2:
;    COMMA, PERHAPS PRECEDED BY SPACE OR ALT MODE.
;    READY TO INPUT SUBCOMMANDS OR NEXT ARG OF LIST.
;
;  RETURN +3:
;    EOL, SPACE-EOL, SPACE-ALT MODE, ALT MODE-EOL, OR 2 ALT MODES.
;    BAKFF SET EXCEPT IN EOL CASE, READY TO CALL "CONF".
;
;CAVEAT: DON'T CALL THIS FOR A COMMAND WITH "CONFRC" BIT SET,
;	BECAUSE IT CAN READ CONFIRMING CHARACTER BEFORE CONF HAS HAD
;	ITS CHANCE TO TYPE "[CONFIRM:]".

SPRTR::	TRNE CBT,TEOL
	AOS (P)		;EOL. R3.
	TRNE CBT,TCOM+TEOL
	JRST [	AOS (P)		;COMMA GETS R2.
		RET]
	ALLOW TSPC+TALT		;ERR IF CHAR NOT EOL, COMMA, SPACE, OR ALT MODE.
	CALL CSTR		;AFTER SPACE OR ALT MODE GET NEXT FIELD.
	CAIGE CNT,2		;NON-NULL, ALWAYS BACK UP AND GIVE R1.
	TRNN CBT,TCOM+TEOL+TALT		;ALSO BAKUP & R1 IF NOT COM, EOL, ALTM.
	JRST [	TLO Z,BAKFF
		RET]
	AOS (P)
	TRNE CBT,TCOM
	RET		;NULL, COMMA: R2 WITHOUT BACKUP.
	TLO Z,BAKFF		;NULL, ALT MODE OR EOL: BACK UP, R3.
	JRST [	AOS (P)
		RET]

;CCHRI
;INPUT A CHARACTER FOR COMMAND STRING INTO "CHR".
;RETURNS IN AC "CBT" THE CHARACTER'S WORD IN THE CHARACTER TABLE --
;   THIS CONTAINS DESCRIPTIVE BITS (SEE COMMENTS ABOVE "CHRTBL")
;STORES IN CBUF (POINTER CBP)
;EDITING CHARACTERS:
; ^A  DELETE CHAR (CAN ONLY DELETE TO BEGINNING OF FIELD)
; ^H  SAME AS ^A
; ^W  DELETE FIELD (CAN ONLY DELETE CURRENT ONE)
; ^X  DELETE LINE (DOESN'T RETURN TO CALLER)
; ^R  RETYPE LINE ? IF COLLECT FILE NAME IS COMPATIBLE.
; ^V  GET ANOTHER CHARACTER AND RETURN IT EVEN IF ITS AN EDITING CHAR,
;       & RETURN "CTRLVF" ON.
;OTHER SPECIAL CHARACTERS:
; (  IF ECHOING OFF, TURN IT ON AND PRINT "(".
;	THIS KLUDGE IS NECESSARY BECAUSE NOISE WORD CAN BE TYPED IN
;	BEFORE PASSWORD.
;CALLERS MUST CLEAR CHARS-IN-FIELD COUNTER (CNT) AT BEGINNING OF EACH
;NEW FIELD.

CCHRI::	PUSH P,A
	PUSH P,B
	MOVEI A,CCHEOF
	MOVEM A,EOFDSP		;SETUP TO DETECT EOF ON COMMAND INPUT
	TLZ Z,CTRLVF		;SAY NO ^V (YET) BEFORE THIS CHARACTER
;RETURN HERE AFTER PROCESSING SPECIAL CHARACTER
;GET CHARACTER INTO "CHR", BITS INTO "CBT", DISPATCH IF SPECIAL

CCHR1:	MOVE A,CIJFN		;INPUT SOURCE DESIGNATOR
	PUSH P,[5]		;Null limit
	BIN			;INPUT CHARACTER TO B
	SOSLE 0(P)		;Drop count
	JUMPE B,.-2		;Haven't reached limit, ignore null
	SUB P,BHC+1		;Drop stack
	CAIE B,15		;REAL CR?
	JRST CCHR1A		;No, skip special CR code
	BIN			;Pickup following LF
	CAIE 2,12		;Be sure it is
	BKJFN			;If not then pick it up next time
	 JFCL
	MOVEI 2,EOL		; and replace with EOL
CCHR1A:	MOVE CHR,B
	AOS TTYACF		;SAY THERE'S BEEN TTY ACTIVITY, SO JOB
		;WON'T GET AUTOLOGOUTED FOR LACK THEREOF
	MOVE CBT,CHRTBL##(CHR)	;BITS WORD FROM CHARACTER TABLE
	TLNE Z,CTRLVF		;PRECEDED BY ^V?
	JRST CCHR8		;YES, NO SPECIAL PROCESSING
	TLNE CBT,-1		;HAS A SPECIAL-CASE DISPATCH ADDR?
	JRST [	HLRZ B,CBT	;YES, DISPATCH.
		JRST (B)]
;NOT SPECIAL. CHECK FOR COMMAND TOO LONG, STORE CHARACTER.

CCHR8:	HRRZ B,BFP
	CAIL B,CBUFE
	ERROR <Command too long>
	AOJ CNT,
	IDPB CHR,BFP		;STORE CHARACTER IN COMMAND BUFFER
	SETZM EOFDSP
	POP P,B
	POP P,A
	RET

;CCHRI...
;ROUTINES FOR SPECIAL CHARACTERS

;PROCESS ^A

$CTRLA::SKIPG CNT		;ANY DELETEABLE CHARACTERS?
	JRST [	CALL DING	;NO, RING BELL
		JRST CCHR1]	;INPUT ANOTHER CHARACTER
	PUSH P,A
NOSRI <	
NOSCRC <
	CALL $DELCH
	 SKIPA
	JRST $CTRA1
>>
SRI <	MOVE A,COJFN
	TLNN Z,NECHOF		;DON'T DELETE CHAR IF ECHO OFF
	DELCH			;JSYS TO DELETE CHAR FROM COJFN
	 JFCL			;UNSUCCESSFUL
	 CAIA			;UNSUCCESSFUL
	 JRST $CTRA1		;SUCCESSFUL!!
>
SCRC <	MOVE A,COJFN
	TLNN Z,NECHOF		;DON'T DELETE CHAR IF ECHO OFF
	DELCH			;JSYS TO DELETE CHAR FROM COJFN
	 JFCL			;UNSUCCESSFUL
	 CAIA			;UNSUCCESSFUL
	 JRST $CTRA1		;SUCCESSFUL!!
>
	PRINT "\"		;YES, ECHO \
	LDB B,BFP
	TLNN Z,NECHOF		;DON'T PRINT IF ECHOING IS OFF
	CALL  CCHRO        	;DELETED CHARACTER
$CTRA1:	POP P,A			;RESTORE AC1 AT AI
	CALL UBP		;BACK UP BFP AND CNT
	JRST CCHR1 		;GET ANOTHER INPUT CHARACTER

;PROCESS ^W

$CTRLW::SKIPG CNT
	JRST [	CALL DING	;NO FIELD TO DELETE
		JRST CCHR1]
	PUSH P,A
$CTRW1:
NOSRI <	
NOSCRC <
	CALL $DELCH
	 JRST $CTRW2
>>
SRI <	MOVE A,COJFN
	DELCH
	 JFCL			;NOT A TERMINAL
	 JRST $CTRW2		;UNSUCCESSFUL: COLUMN 0 (HUH?)
	 CAIA			;CHARACTER POSITION DELETED
	JRST $CTRW2		;NOT A DATAMEDIA SCOPE
>
SCRC <	MOVE A,COJFN
	DELCH
	 JFCL			;NOT A TERMINAL
	 JRST $CTRW2		;UNSUCCESSFUL: COLUMN 0 (HUH?)
	 CAIA			;CHARACTER POSITION DELETED
	JRST $CTRW2		;NOT A DATAMEDIA SCOPE
>
	CALL UBP
	JUMPG CNT,$CTRW1	;UNTIL I RUN OUT OF CHARACTERS
	POP P,A
	JRST CCHR1

$CTRW2:	POP P,A
	UTYPE [ASCIZ /_/]
	CALL UBP
	JUMPG CNT,.-1
	JRST CCHR1 

NOSRI <
NOSCRC <
$DELCH:	TLNN Z,NECHOF
	SKIPN BSFLG
	RET
	PUSH P,B
	PUSH P,C
	MOVE A,COJFN
	RFCOC
	PUSH P,B		;Save first CCOC word
	PUSH P,C
	TLZ B,(3B17)		;Clear backspace control field
	TLO B,(2B17)		;Set to send
	SFCOC
	MOVEI B,10		;Backspace
	BOUT
	MOVEI B,SPACE
	BOUT
	MOVEI B,10
	BOUT
	POP P,C
	POP P,B
	SFCOC
	POP P,C
	POP P,B
	AOS 0(P)
	RET
>>

;PROCESS ^R

$CTRLR::TLNE Z,NECHOF		;IS ECHOING OFF?
	JRST [	CALL DING	;YES
		JRST CCHR1]	;GO GET NEXT CHAR
	CALL DOECEO		;MAKE SURE EOL WILL PRINT
	SETZ CHR,
	MOVE B,BFP
	IDPB CHR,B      	;TERMINATE WITH 0
	PRINT EOL
	PRINT " "
	UTYPE CBUF      	;TYPE CR, SPACE, COMMAND BUFFER
	TLNE Z,NEOLF		;IF EOL ECHO SUPPRESSION IN EFFECT,
	CALL NOECEO		;CHANGE CCOC BACK SO EOL'S WON'T PRINT
	JRST CCHR1

;PROCESS ^X

$CTRLX::.$ERROR <^X>;	XXX?

;PROCESS RUBOUT (LATER A PSI(?))

$RUB::	.$ERROR <XXX>		;.$ERROR MEANS NO CR FIRST, NO CLR INBUF

;CCHRI...   ROUTINES FOR SPECIAL CHARACTERS...

;PROCESS ^L (FORMFEED)

$FORMF::CALL DOECEO		;MAKE EOL'S PRINT
	PRINT EOL		;ECHO CR-LF AFTER FORMFEED
		;ABOVE FAILS IF FORM FEED IS BACKED UP OVER: TWO EOL'S ECHOED.
		;DON'T THINK IT CAN HAPPEN. 5/14/70.
FORMF1:	TLNE Z,NEOLF		;IF EOL ECHO SUPPRESSION IN EFFECT,
	CALL NOECEO		;CHANGE CCOC SO EOL'S WON'T PRINT
	JRST CCHR8

;PROCESS ^J (LINEFEED)

$LINF::	MOVEI CHR,EOL		;MAKE IT LIKE AN EOL
	;...			; PROCESS LIKE EOL

;PROCESS EOL

$EOL::	TLNE Z,NEOLF		;EOL ECHOING SUPPRESSED?
	TLO Z,EOLNEF		;YES, SAY THERE IS AN UNECHOED EOL.
	JRST CCHR8

;PROCESS "-"

$DASH::	TLNE Z,DASHF		;"DASHF" MAKES IT NON-ALPHANUMERIC, AND THUS
	TRZ CBT,ALPHAN		;A TERMINATOR.  USED IN "LIST" SUBCMD "PAGES".
	JRST CCHR8

;PROCESS ^V

$CTRLV::TLO Z,CTRLVF		;INDICATE PRECEDED BY ^V
	JRST CCHR1		;GO GET ANOTHER CHARACTER

;PROCESS CONTINUATION CHARACTER (&)

$CONT::	CALL DOECEO		;MAKE EOL'S PRINT
	PRINT EOL		;ECHO EOL-SPACE
	PRINT " "
	MOVE CBT,CHRTBL##+" " ;RETURN BITS FOR SPACE
	MOVEI CHR,CONTCH		;STORE SPECIAL CHARACTER IN CBUF
	JRST FORMF1		;GO SUPPRESS EOL PRINTING IF FLAG ON & JRST CCHR8
		;"CONTCH" IS USED BECAUSE MUST STORE A SINGLE BYTE BUT
		;KNOW TO TRANSLATE IT TO 3 BYTES (&-EOL-SPACE) ON OUTPUT BY
		;^A OR ^R.

;SUBROUTINE TO BACK UP ONE CHARACTER IN COMMAND STRING.
;UN-INCREMENTS "BFP" AND "CNT".

UBP::    SOJ CNT,
	ADD BFP,[7B5]   	;UNCREMENT BYTE POINTER
	TLNE BFP,40B23  	;THIS FAILS FOR POINTERS TO BIT -1
	SUB BFP,[43B5+1]	;(SUCH POINTERS SHOULD NEVER GET HERE)
	RET

;EOF WHILE READING COMMAND FILE
; THIS IS CALLED AT COMPUTE LEVEL, NOT PSI LEVEL

CCHEOF:	NOINT
	MOVEI A,.FHSLF
	GPJFN
	HLRZM 2,CRJFNI
	HRRZM 2,CRJFNO		;SAVE FOR * IN "RED" OR "DET" CMND
	MOVE B,PRIMRY		;REVERT TO JFNS WE HAD AT ENTRY
	SPJFN
	MOVEI 1,100
	MOVEM 1,CIJFN
	MOVEI 1,101
	MOVEM 1,COJFN
CCHEF1:	MOVE 1,CRJFNI		;OLD INPUT FILE
	CALL CRIF		;DO SPC OR CR-SPC IF NEEDED
	ETYPE <[EOF on %1S]>
	PRINT EOL
	CAIE 1,-1		;PREVIOUS INPUT WAS CONTROLLING TTY?
	SKIPL CREDIF		;WAS INPUT REDIRECTED?
	 JRST CCHEF2		;YES OR NO
	CLOSF
	 CALL SCREWUP
CCHEF2:	SETZM CREDIF		;SAY INPUT NOT NOW REDIRECTED
CCHEF3:	MOVE 1,CRJFNO
	CAIE 1,-1
	SKIPL CREDOF
	 JRST CCHEF4
	CLOSF
	 CALL SCREWUP
CCHEF4:	SETZM CREDOF
	OKINT
	CALL RLJFNS		;RELEASE JFN'S
	JRST ERRET##		;BACK TO MAIN LOOP (FOR NOW)

;SERVICE ROUTINE FOR OUTPUT STRING UUO ("TYPE" MACRO)
;       UTYPE [ASCIZ @TEXT@]

;AND
;SUBROUTINE TO TYPE STRING FOR BYTE PTR IN A (CTYPE)

%TYPE::	PUSH P,A		;UUO SERVICE ENTRY
	HRR A,40
	HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE POINTER TO ARGUMENT
TYP1:   PUSH P,B
TYP2:   ILDB B,A
	JUMPE B,[POP P,B
		POP P,A
		RET]
	CALL CCHRO		;OUTPUT CHARACTER IN B
	JRST TYP2

CTYPE::	PUSH P,A		;SUBR ENTRY
	JRST TYP1

;SIMILAR BUT ALSO STORE TEXT IN COMMAND BUFFER.
;USE FOR NOISE WORDS & PRINTING REST ON ALT MODE, SO ^R PRINTS IT ALL

%$TYPE::PUSH P,Z		;UUO ENTRY
	TLO Z,STCF		;FLAG TELLS "CCHRO" TO STORE CHARACTERS
	CALL %TYPE
	POP P,Z		;RESTORE PREVIOUS STATE OF STCF
	RET

$CTYPE::PUSH P,Z		;SUBROUTINE ENTRY
	TLO Z,STCF
	CALL CTYPE
	POP P,Z
	RET

;SIMILAR BUT ONLY DO IT IF TERMINATOR (IN AC "TRM") IS ALT MODE.
;USED TO TYPE REST OF RECOGNIZED WORD, SPACES BEFORE ARGUMENTS, ETC.
;MACRO "ALTYPE", UUO "UALTYP".

%ALTYP::CAIN TRM,ALTM
	JRST %$TYPE
	RET

;SEE ALSO "%ETYPE" IN S3.MAC

;COLLECT FILE NAMES:
;CINFN & COUTFN & SPECFN & CPFN & .INFG & INFG & DIRARG & SO ON.
;VARIOUS ENTRIES FOR INPUT, OUTPUT, SPECIAL CASE, & GROUP DESCRIPTORS.
;CAN INPUT LIST OF NAMES SEPARATED BY COMMAS AS WELL AS *.MAC FORMS.

;TAKE: A: RH: 0, 2, OR DEFAULT EXTENSION POINTER
;	      2 => USE LAST NAME INPUT AS DEFAULT NAME
;         LH: 0, -1, -2, 1, 2, OR DEFAULT NAME POINTER
;	      0 => RETURN +1 IF NULL, PRINTING "-" ON ALT MODE
;	      1 => LIKE 0 BUT ALSO RETURN +1 IF "*" INPUT
;	      2 => LIKE -1 BUT USE EXT OF LAST FILE NAME INPUT AS
;		   DEFAULT EXT
;	      -1=> GIVE INPUT TO GTJFN EVEN IF NULL OR *
;	      -2   LIKE -1 BUT GIVE R1 IF NO SUCH FILE
;    ALSO ENTRY "SPECFN" TAKES IN B: LH: DEFAULT VERSION (USUALLY 0)
;	RH: FLAGS FOR GTJFN PLUS:
;	    B15: ALLOW GROUP OF NAMES, ALL BUT LAST TERMINATED WITH ",".
;		 DOES NOT HANDLE ALTMODE-COMMA (USE ^F FOR RECOGNITION),
;		 MAY THUS BE USED WHERE A NOISE WORD, ETC FOLLOWS (COPY)
;	    B16 & B17 ARE HAIRY: THE CASUAL READER SHOULD DISREGARD
;			 THEM.
;	    B16: ALLOW GROUP OF NAMES SEPARATED BY SPACE, ALTMODE, OR
;		 SPACE-COMMA OR ALTMODE-COMMA. IF LAST COMMA IS FOLLOWED
;		 BY ALTMODE OR EOL, GIVE R1 (TO INDICATE SUBCOMMAND
;		 INPUT REQUIRED).
;		 B15 SHOULD ALSO BE ON.
;		 ONLY USEABLE IF LIST IS LAST THING IN COMMAND; CAN
;		 PRE-READ FOLLOWING FIELD HENCE WONT WORK WITH "CONFRC".
;	    B17: DEFAULTS NULL WITHOUT LETTING THE USER BE AWARE
;		 OF THIS (NO PRINTOUT, RETURN WITH BAKFF ON IF IT
;		 WAS ALT MODE).
;			EG "DIRECTORY$$" AND "DIRECTORY$ *.*$$" ARE =.
;		 ALSO IF AT ENTRY PRECEDING FIELD ENDED IN COMMA OR EOL,
;		 BEHAVE AS THO THAT CHARACTER WERE INPUT HERE &
;		 DEFAULT ACCORDINGLY.
;			EG "DIRECTORY,$", "DIRECTORY ,$" ARE SAME.

;	    B14: ALLOW * FOR NAME IN EMPTY DIRECTORY, RETURNING -2
;		 IN PLACE OF JFN.
;		 (NOT WORKING 2/9/71 CAUSE GJFX32 NOT WORKING.)
;
;
;    ALSO, F3 IN Z  SAYS TO DEFAULT DIRECTORIES TO CONNECT AND LOGIN
;	AFTER INITIAL TRY FAILS --  FOR DEFAULT RUN

;COLLECT FILE NAMES COMMENTS...

;RETURN: +1: NULL INPUT AND 0 OR 1 IN LH OF A, OR "-" INPUT,
;		OR "*" INPUT AND 1 IN LH OF A (INDICATED BY "*" IN A),
;		OR TRM=EOL AT ENTRY (IN WHICH CASE NO INPUT),
;		OR -2 IN LH OF A AND NO SUCH FILE,
;		OR B16 ON AND LIST ENDED WITH COMMA.
;		THE FIRST 3 OF THESE RETURN +1 OPTIONS SHOULDN'T
;		BE USED IF B15, B16, OR B17 ON.
;	 +2: SUCCESS, JFN IN A AND ALSO STACKED IN BUFFER "JBUF"
;		(POINTER JBUFP). 1ST LOCATION IN THIS BUFFER
;		(FIRST JFN IN COMMAND) CAN BE ADDRESSED AS CJFN1,...
;		IF AN INPUT GROUP DESCRIPTOR COULD HAVE BEEN INPUT
;		(B11,15,16,OR 17 ON), SETS INIFH1 &2 TO 1ST & LAST USED
;		LOCS IN JBUF, RETURNS FIRST JFN IN A, AND SETS "GROUPF"
;		IF A GROUP WAS SPECIFIED (* OR MORE THAN 1 NAME INPUT).

;	 EITHER: TERMINATOR IN "TRM"
;ASSUME NULL INPUT IF LAST TERMINATOR=EOL AND BAKFF OFF,
; AS %KEYW DOES.  SEE %KEYW'S GLITCH NOTE (S1.MAC).

;FLAGS IN AC D
;RH: FROM CALLER
;LH: B0: NULL INPUT UNDER B17 OPTION
;    B1: B16 ON, ALREADY AT LEAST ONE ARG, NOT FOLLOWED BY COMMA
;    B2: DITTO, DITTO, FOLLOWED BY COMMA

;COLLECT FILE NAMES...  ENTRIES.

;OUTPUT FILE NAME ENTRY (OLD OR NEW NAME).
;PRINTS WHETHER OLD OR NEW, NO CONFIRMATION.

COUTFN::PUSH P,B
	MOVEI B,440000		;GTJFN FLAGS FOR OUTPUT FILE NAME
	JRST CFN1

;INPUT (OLD FILE REQUIRED)

CINFN::	PUSH P,B
	MOVEI B,100000		;FLAGS FOR GTJFN FOR INPUT FILE
	JRST CFN1

;EDIT FILE NAME -- MAY OR MAY NOT EXIST YET

CEDFN::	PUSH P,B
	MOVE A,EDFILE		;POINTERS TO DEFAULT NAME AND EXT.
	MOVEI	B,B3		;PRINT NEW/OLD, NO SPEC OPTIONS
	JRST CFN1


;THE NEXT FOUR ENTRIES INPUT AN INPUT FILE GROUP.
;ALL PERMIT *'S AND ADDITIONAL NAME AFTER ONE TERMINATED BY COMMA.
;NO SPECIAL RETURN FOR "*" OR NULL INPUT.
;THESE EXEMPLIFY USE OF GROUP FEATURES, OTHERS POSS USING "SPECFN".

;COLLECT FILE NAMES...   GROUP ENTRIES

;.INFG
;ACCEPTS COMMAS ONLY IF THEY TERMINATE FILE NAME - 
; THUS ^F MUST BE USED FOR RECOGNITION IF COMMA IS TO FOLLOW.
;SUITABLE FOR USE WHERE ADDITIONAL FIELDS OF COMMAND FOLLOW,
; AS IN 1ST ARG TO "COPY".
;NAME AND EXT DEFAULT TO LAST INPUT (THUS NONE FOR 1ST IN GROUP),
; VERSION TO HIGHEST.
;ONE RETURN ONLY.

.INFG::	PUSH P,B
	MOVEI B,B2+B11+B15	;GTJFN & LOCAL FLAGS: OLD FILES,
				;*'S FOR INPUT, MINIMUM COMMA OPTION.
.INFG1:	MOVE A,[XWD 2,2]
	CALL SPECFN
	 JRST CERR
	JRST [	POP P,B
		RET]

;INFG
;SIMILAR BUT ALSO ALLOWS COMMAS AFTER ALTMODE OR SPACE AND
; ADDITIONAL NAMES WITHOUT COMMA AFTER ALTMODE OR SPACE.
;SUITABLE FOR USE ONLY AT END OF COMMAND, AS WITH "LIST".
;WARNING: CAN PRE-READ CONFIRMATION CHARACTER.

INFG::	PUSH P,B
	MOVEI B,B2+B11+B15+B16
	JRST .INFG1

;$INFG
;SIMILAR TO ABOVE EXCEPT RETURNS +1 IF LIST ENDED WITH COMMA NOT
;FOLLOWED BY ANOTHER NAME (TO INDICATE SUCCOMMAND INPUT).

$INFG::	PUSH P,B
	MOVEI B,B2+B11+B15+B16
	MOVE A,[XWD 2,2]
	JRST CFN1

;DIRARG
;FANCIEST INPUT GROUP, LIKE ABOVE EXCEPT:
; DEFAULTS NAME, EXT, VERSION TO "*". ALLOWS DELETED FILE NAMES (UG!).
; IF PRECEDING FIELD ENDED WITH COMMA OR EOL, OR IF A NULL ARG IS
; SEEN, SUPPLIES DEFAULT ARG "*.*;*" BUT HIDES THIS FROM USER.
; ACCEPTS * FOR NAME IN EMPTY DIRECTORY

DIRARG::PUSH P,B
	MOVE A,[XWD [ASCIZ /*/],[ASCIZ /*/]]
	HRLI B,-3		;DEFAULT VERSION: *
	HRRI B,B2+B8+B11+B14+B15+B16+B17
	JRST CFN1

;COLLECT FILE NAMES ENTRIES...

;ENTRY FOR GTJFN FLAGS IN RH OF B, DEFAULT VERSION (NORMALLY 0) IN LH.
; USED IN SPECIAL CASES, EG:
;	DEFAULT TO LOWEST VERSION FOR "DELETE" (-2 IN LH B)
;	DELETED FILE NAME FOR "UNDELETE"
;	NEW NAME FOR "DEFINE"
;	ANYWHERE *'S ARE ALLOWED, AS IN "DIRECTORY".

SPECFN::PUSH P,B

;END OF ENTRIES.  CASES MERGE HERE.

CFN1:	SETZM CJFNBK+3		;NO DEFAULT DIRECTORY
CFN1A:	PUSH P,C		;"CPFN" SETS DEFAULT DIR AND JOINS HERE.
	PUSH P,D
	HRRZ D,B		;SAVE GTJFN AND LOCAL FLAGS IN RH D
		;NOTE: B0 OF LH D USED AS A FLAG IN CONJUNCTION WITH
		;NULL INPUT UNDER B17 OPTION
	TRZ B,B15+B16+B17	;DON'T GIVE LOCAL FLAGS TO GTJFN
	TRNE D,B11+B15+B16+B17	;IF AN INPUT GROUP IS BEING REQUESTED,
	SETZM INIFH1		;SAY NO NAMES HAVE BEEN INPUT YET.
	TRNE D,B17
	TRNN CBT,TCOM+TEOL
	JRST CFN1B
	TLOE Z,BAKFF
	JRST CFN1B
		;B17 OPTION ON AND LAST FIELD ENDED IN COMMA OR EOL.
		;BEHAVE AS THO FIRST INPUT FIELD WAS JUST THAT CHARACTER
	MOVE .BFP,BFP
	CALL UBP		;UNINCREMENT BFP
	EXCH .BFP,BFP		;SET UP PTRS TO TERMINATOR ONLY
	MOVEI CNT,1		;NULL FIELD. BAKFF ALREADY ON.
	MOVEI C," "
	TRNE CBT,TEOL		;CHANGE EOL TO SPACE SO GTJFN WON'T
	DPB C,BFP		;"ECHO" EXTRA CR
CFN1B:	TLNE Z,BAKFF		;IF THERE'S AN UNUSED FIELD,
	JRST .+3		;THEN THE COMMAND HASN'T ENDED.
	TRNE CBT,TEOL		;LAST TERMINATOR CR OR ; ?
	JRST CFN9		;YES, IT ENDED COMMAND, NO MORE INPUT

;COLLECT FILE NAMES...
;SET UP GTJFN PARAMETER BLOCK
	MOVSM B,CJFNBK		;FLAGS AND DEFAULT VERSION
	MOVE B,COJFN
	HRL B,CIJFN
	MOVEM B,CJFNBK+1		;XWD INPUT JFN, OUTPUT JFN
;COME BACK HERE TO GET ANOTHER FILE NAME IN GROUP

CFN2:	TLZ D,B0
; FORM "DEFAULT STRING POINTER" TO EXTENSION
	HRRZ B,A
	HRLZI C,B11		;ARGUMENT FOR LFJFNS: EXT ONLY, NO PUNCT
	CAIN B,2		;2 SAYS USE EXT OF LAST FILE NAME INPUT
	CALL LFJFNS		;GET A STRING FOR LAST FILE'S EXT
	JUMPE B,.+2
	HRLI B,<POINT 7,0,-1>B53
	MOVEM B,CJFNBK+5
; FORM "DEFAULT STRING POINTER" TO DEFAULT NAME
	HLRZ B,A
	HRLZI C,B8		;ARGUMENT FOR LJFNS: NAME ONLY, NO PUNCT
	CAIN B,2		;2 SAYS USE NAME OF LAST FILE NAME INPUT
	CALL LFJFNS		;GET A STRING FOR LAST FILE'S NAME
	CAIE B,-2
	CAIN B,-1
	SETZ B,
	JUMPE B,.+2
	HRLI B,<POINT 7,0,-1>B53
	MOVEM B,CJFNBK+4

;COLLECT FILE NAMES...
;NOW WE MUST READ TEXT UP TO A FILE NAME FIELD TERMINATOR,
; TO ALLOW EDITING, THEN CHECK FOR SPECIAL CASES: NULL, "-", AND "*".
;RETURN HERE TO RETRY AFTER ERROR RETURN FROM GTJFN.

CFN3:	TLO Z,PUNCF+NEOLF ;SAY READ INPUT TO FILE FIELD TERMINATOR
		;AND DON'T ECHO EOL (BECAUSE GTJFN PRINTS EOL
		;WHEN APPROPRIATE EVEN IF IT WAS PRE-READ).
	INHELP <File name>	;INPUT FIELD, TYPE MESSAGE ON "?"
	TRNN CBT,TSPC+TALT+TEOL+TCOM
	JRST CFN4	;END OF FIELD, NOT WHOLE NAME, NOT SPEC CASE
	CAIE CNT,1
	JRST CFN3B
		;NULL CASE
		;NULL INPUT TERMINATING LIST UNDER B16 OPTION IS PROCESSED
		;HERE RATHER THAN AFTER GTJFN FOR CORRECT BEHAVIOR AFTER ERROR:
		;IE BAD FILE NAME TYPES "?", THEN IF JUST A CR IS INPUT,
		;PRECEDING LIST IS PROCESSED AS THO IT WAS TERMINATED BY THE CR.
	TRNN CBT,TALT+TEOL
	JRST .+5		;ANOTHER COMMA DOESN'T END LIST
	TLNE D,B2		;B16 & PREV FIELD ENDED WITH COMMA?
	SOSA -3(P)		;YES, CANCEL AOS BELOW TO GIVE R1 AFTER
		;GOING THRU GOOD RETURN CODE
	TLNE D,B1		;B16 & NO COMMA AFTER PREV ARG?
	JRST [	PUSH P,A	;YES. INTERFACE TO EXIT CODE AT "CFN7Z"
		CAIN TRM,ALTM	;..  DON'T BUFFER ALT MODES, CAUSE
		CALL UBP	;..  OTHERWISE "ALTYPE ( )" SETS CNT TO
				;    2 AND "CONF" GIVES AN ERROR.
		TLO Z,BAKFF	;RE-USE ALTM OR EOL AS CONFIRMING CHAR
		JRST CFN7Z]
	TRNE D,B17		;B17 OPTION (SEE COMMENTS AT BEGINNING) 
	TRNN CBT,TALT		;YES, NULL ONLY SPECIAL IF ALTMODE
	JRST CFN3A
	MOVEI B," "
	DPB B,BFP		;SUPPRESS PRINTOUT OF DEFAULT
	TLO D,B0		;INVOKE ADDL SPECIAL STUFF AFTER GTJFN
	JRST CFN4
CFN3A:	TLNE A,-2		;DID CALLER GIVE A DEFAULT NAME,
				;OR -1 TO SAY "NO SPEC CASE FOR NULL"?
	JRST CFN4		;YES, GO GTJFN
	UALTYP [ASCIZ /-/]		;NO. PRINT "-" IF ALT MODE.
	JRST CFN9		;RETURN +1
CFN3B:	CAIN CNT,2
		;ONE-CHARACTER CASE
	JRST [	MOVE B,.BFP		;GET THE ONE CHARACTER
		ILDB B,B		;...
		CAIN B,"-"		;WAS IT "-"?
		JRST CFN9		;YES, RETURN +1.
		CAIE B,"*"		;WAS IT ASTERISK?
		JRST .+1		;NO, NOT SPECIAL, GO GTJFN.
		HLRZ B,A		;YES, DID CALLER REQUEST SPECIAL
		CAIE B,1		;...HANLDING OF ASTERISK?
		JRST .+1		;NO.
		MOVEI A,"*"		;YES, RETURN +1 WITH "*" IN A.
		JRST CFN9]

;COLLECT FILE NAMES...
;HERE WHEN EXCEPTIONS ELIMINATED AND MUST "GTJFN"

CFN4:	PUSH P,A		;SAVE FOR ERROR RETRY
	HLRZ B,JBUFP		;CHECK SPACE IN JFN BUFFER
	CAIN B,-1
	ERROR <Too many JFN's in command>
	SETZ C,			;PATH COUNTER / INDEX INTO DIR BLK
CFN41:	MOVEI A,CJFNBK		;GTJFN PARAMETER BLOCK LOCATION
	MOVE B,.BFP		;POINTER TO STRING INCLUDING TERMINATOR
	GTJFN			;GET JFN FOR NAME. TAKES MORE INPUT FROM
				; COMMAND FILE (TTY) IF NEEDED.
	 CALL CFN42		;TRY SEARCH PATH, REMEMBER PC
	JRST CFN4Z		;SUCCESS

;BUMP DEFAULT DIRECTORY AND TRY AGAIN IF USING SEARCH PATH
CFN42:	CAIE 1,GJFX4		;FORGET IT IF ILLEGAL CHARACTER
	TLNN Z,F3		;USING SEARCH PATH?
	JRST CFNE		;NO.  HANDLE ERROR
	ADDI C,1		;TRY NEXT DIRECTORY
	MOVE B,CDEFDR(C)	;ITEM
	JUMPE B,CFNE		;NO MORE, HANDLE ERROR
	JUMPL B,CFN43		;NEG MEANS CONNECTED
	HRROI A,IUSRNM		;DIRECTORY STRING STORAGE
	DIRST			;
CFN43:	 TDZA B,B		;SCREWUP OR USE CONNECTED
	HRROI B,IUSRNM		;
	MOVEM B,CJFNBK+3	;DEFAULT DIR ENTRY FOR GTJFN
	SUB P,[XWD 1,1]		;WE CAME HERE WITH A CALL
				; IMMEDIATELY AFTER THE GTJFN
	JRST CFN41		;

CFN4Z:	MOVE B,JBUFP		;ADD JFN TO STACK. MUST HAPPEN PROMPTLY
	PUSH B,A		;SO IT WILL GET RELEASED ON ERRORS.
	MOVEM B,JBUFP


;PUT FILE NAME TEXT (UNFORTUNATELY NOT NECESSARILY AS INPUT)
; INTO COMMAND STRING BUFFER, FOR ^R.
	MOVE B,A		;JFN
	MOVE A,.BFP		;DEST: OVERWRITE WHAT WAS PRE-READ
	SETZ C,			;DEFAULT FORMAT
	CAMN B,[-2]		;NULL TEXT FOR EMPTY DIRECTORY
	JRST CFN4Z0		;FORGET JFNS
	TLNN B,(77B5)		;DID HE TYPE ANY *'S
	TLZ B,(7B8)		;NO.  REMOVE DEFAULT BITS.
	JFNS			;JFN TO STRING CONVERSION
CFN4Z0:	MOVE BFP,A		;NEW END OF COMMAND STRING
	CALL INTRM		;GET TERMINATING CHR OF FIELD GTJFN READ
	MOVE A,B		;JFN TO A TO RETURN

;COLLECT FILE NAMES...
;CODE FOR THE VARIOUS GROUP CASES
	TRNN D,B11+B15+B16+B17
	JRST CFN8		;NO SUCH OPTIONS ON
	TLZE D,B1+B2		;B16 AND NOT FIRST ARG?
	TLO Z,GROUPF		;YES, SAY GROUP INPUT.
	HRRZ B,JBUFP
	SKIPN INIFH1		;FIRST JFN IN GROUP?
	MOVEM B,INIFH1		;YES, SAVE JBUF POINTER
	TLNE A,<77B5>B53		;ANY *'S INPUT OR DEFAULTED TO?
	TLO Z,GROUPF		;YES, SAY GROUP WAS SPECIFIED.
	TLNN D,B0		;WAS IT ALTMODE ONLY & B17 OPTION ON?
	JRST CFN7A		;NO
		;AFTER ALTMODE TO B17 OPTION RETURN IMMEDIATELY
		;WITH BAKFF ON SO THE ALT MODE FUNCTIONS AS CONFIRMATION CHAR
	TLO Z,BAKFF
	JRST CFN7Z
CFN7A:	TRNE D,B15
	CAIE TRM,","
	JRST CFN7C
		;COMMA TERMINATOR AND B15 ON
	HLRZ A,JBUFP		;JFN LIST PUSH POINTER
	CAIN A,-2
	 JRST [	UTYPE [ASCIZ /[File list full]/]
		MOVEI 1,^D500
		DISMS
		MOVEI 1,100
		CFIBF
		MOVEI TRM,33	;FAKE ALTMODE AS TERMINATOR
		MOVEI CBT,TALT
		JRST CFN7Z]	;AND GET OUT
	TRNE D,B16
	JRST CFN7D
		;GO GET NEXT ARGUMENT OF LIST
	TLO Z,GROUPF		;SAY A GROUP HAS BEEN INPUT
CFN7B:	POP P,A		;RESTORE CALLER'S A
	JRST CFN2		;GO RESETUP DEFAULTS AND READ ANOTHER ARG

;COLLECT FILE NAMES...  GROUP CASES CODE...

CFN7C:	TRNE CBT,TALT+TSPC
	TRNN D,B16
	JRST CFN7Z
		;ALTMODE OR SPACE TERMINATOR AND B16 ON.
		;PREREAD NEXT FIELD AND CHECK FOR COMMA.
	ALTYPE ( )
	HLRZ A,JBUFP		;FILE LIST PUSH POINTER
	CAIN A,-2
	 JRST [	UTYPE [ASCIZ /[File list full]/]
		MOVEI 1,^D500
		DISMS
		MOVEI 1,100
		CFIBF
		JRST CFN7Z]
	TLO Z,NEOLF
	CALL CSTR
	CAIE CNT,1
	JRST .+3		;NON-NULL, ITS ANOTHER ARG
	TRNE CBT,TCOM
	JRST CFN7D		;NULL, COMMA, IS SEPARATOR, DONT REUSE
	TLO Z,BAKFF		;SAY RE-USE FIELD
	TLOA D,B1		;SAY B16 AND NO COMMA & GET NEXT ARG
		;B16 ON AND COMMA SEEN.
CFN7D:	TLO D,B2		;SAY B16 AND COMMA SEEN
	JRST CFN7B		;GO GET NEXT ARG OR TERMINATE LIST ON NULL
CFN7Z:	HRRZ B,JBUFP
	MOVEM B,INIFH2		;RETURN JBUFP VALUE FOR LAST NAME IN GROUP
	MOVE A,@INIFH1		;RETURN FIRST, NOT LAST, JFN IN A

;COLLECT FILE NAMES...
;END OF GROUP CASES CODE. RETURN.

CFN8:	POP P,B			;THROW AWAY JUNK. JFN TO RETURN IS IN A
	AOS -3(P)		;+2
CFN9:	TLZE Z,EOLNEF		;IF THERE'S UNECHOED EOL,
	JRST [	MOVE	B,CJFNBK;GET GTJFN BITS
		TLNN	B,(1B3)	;WAS CONFIRMATION MESSAGE PRINTED?
		PRINT	EOL	;NO, ECHO EOL NOW!
		JRST	CFN9A]
	ALTYPE ( )		;TYPE SPACE IF IT ENDED WITH ALT MODE
CFN9A:	POP P,D
	POP P,C
	POP P,B		;+1
	RET

;COLLECT FILE NAMES...
;GTJFN ERROR RETURN PUSHJ'S HERE WITH ERROR CODE IN A.
;MOST ERRORS ARE FILE NOT FOUND OR SELF-EVIDENT SYNTAX ERRORS.
; FOR THOSE TYPE " ? " AND REPEAT GTJFN.
;FIRST TEST ERROR CODE FOR EXCEPTIONS.

CFNE:	CAIN A,GJFX3
	ERROR <No JFN's available: You must close some files first>
	CAIN A,GJFX22
	ERROR <JSB full: Try closing some files then repeating command>
	CAIN A,GJFX23
	ERROR <Directory full: Can't create new files until you
 "Delete" some files and "Expunge (Deleted files)">
	CAIN A,GJFX27
	ERROR <New filename required>
	CAIN A,GJFX28
	ERROR <Device not mounted>
	CAIN A,GJFX29
	ERROR <Device assigned to another job>
	CAIN A,GJFX31
	ERROR <Bad use of *>
	CAIN A,GJFX32
	JRST [		;IF FLAG B14 ON GIVE GOOD RETURN WITH -2 INSTEAD
		;OF JFN WHEN GJFX32 ERROR OCCURS.
		;USED FOR "DIRECTORY" (DIRARG).
		TRNN D,B14
		UERR [ASCIZ /No such files in that directory/]
		HRROI A,-2
		RET]		;RETURNS TO LOC(GTJFN) +2
	SUB P,[XWD 1,1]		;DISCARD PC SAVED FOR JERR (NOT USED 6/29/70)
	TLZ Z,EOLNEF		;DON'T ECHO ANY "UNECHOED" EOL (GTJFN DID IT)
	PUSH P,.BFP
	CALL INTRM		;GET TERMINATOR
	HLRZ A,-1(P)		;MOST GTJFN ERRORS RETURN +1 IF CALLER GAVE
	CAIN A,-2		;... -2 IN LH OF A.
	JRST [	POP P,.BFP		;(THIS FEATURE USED ONLY FOR
		POP P,A		; CPFN. 4/30/70)
		JRST CFN9]		;RETURN +1.
	TRNE CBT,TEOL
	JRST CERR		;NO RETRY AFTER CARRIAGE RETURN
	TYPE < ? >;
	MOVEI 1,^D500
	DISMS
	MOVEI 1,100
	CFIBF
	POP P,BFP		;OLD .BFP VALUE: CLEAR NAME FROM BUFFER
	POP P,A
	BTCHER		;STOP NON-CONVERSATIONAL JOB
	JRST CFN3

;INTRM
;GET TERMINATOR AFTER GTJFN, ETC, BY RE-READING CHARACTER.

INTRM::	PUSH P,A
	MOVE A,CIJFN
	BKJFN		;"UN-INPUT" IT
	 CALL JERR
	POP P,A
	MOVE .BFP,BFP		;INITIALIZE FIELD TO PREVENT EDITING
	SETZ CNT,		;(PROBABLY UNNECESSARY)
	CALL CCHRI		;READ CHARACTER
	CAIN CHR,ALTM
	CALL UBP		;DON'T BUFFER ALT MODES
	MOVE TRM,CHR
	RET

;LFJFNS: SUBROUTINE FOR CINFN, COUTFN, SPECFN.
;DO A JFNS FOR MUST RECENT PREVIOUSLY INPUT FILE NAME, USING
; JFNS FORMAT SPECIFICATION IN C.
;RETURNS IN B: POINTER TO LEFT-ADJUSTED STRING
;IF LAST JFN NOT ON A DIRECTORY DEVICE, OR NO PREVIOUS JFN FOR THIS
; COMMAND, RETURNS 0 IN B.

LFJFNS:	PUSH P,A
	HRRZ B,JBUFP		;JFN STACK POINTER
	CAIN B,JBUF-1		;HAS A NAME BEEN INPUT YET?
	JRST LFJF9		;NO, GO RETURN 0 POINTER
	HRRZ A,(B)		;PICK UP JFN OF LAST NAME INPUT
	CAIN A,-1
	JRST LFJF9		;-1 ISN'T A JFN BUT MIGHT GET HERE
	PUSH P,C
	DVCHR		;GET DEVICE CHARACTERISTICS FOR JFN
	POP P,C
	TLNN B,B2
	JRST LFJF9		;NOT A DIRECTORY DEVICE, RETURN 0
	HRRZ A,CSBUFP		;STRING BUFFER POINTER RH
	ADD A,[POINT 7,1,-1]		;BEGINNING OF NEXT WORD
	MOVEM A,CSBUFP
	MOVE B,JBUFP
	MOVE B,(B)		;PICK UP JFN AGAIN
	JFNS		;DO THE JFN TO STRING CONVERSION
	SETZ B,
	IDPB B,A		;APPEND NULL TO STRING
	EXCH A,CSBUFP		;UPDATE BUFFER PTR, GET STRING BEGINNING
	SKIPA B,A		;RETURN STRING POINTER IN B
LFJF9:	SETZ B,		;RETURN 0 IF CAN'T RETURN A STRING
	POP P,A
	RET

;CPFN: COLLECT PROGRAM FILE NAME
;TAKES: A: 0 OR WORD POINTER TO DEFAULT DIRECTORY NAME.
;NO DEFAULT NAME, DEFAULT EXTENSION ALWAYS ".SAV".
;RETURNS +1 ON GTJFN FAILURE.

;If F3 is on then use the search path instead of directory
;specified in A

CPFN::	PUSH P,B
	TLNE Z,F3		;USE SEARCH PATH?
	SKIPN B,CDEFDR		;AND IT IS INITIALLIZED
	JRST CPFN1		;NO. HANDLE NORMALLY
	JUMPL B,CPFN2		;NEG. SAYS FIRST DEFAULT TO CONN.
	HRROI A,IUSRNM		;PLACE TO STORE STRING
	DIRST			;
CPFN2:	 TDZA A,A		;USE CONNECTED ON BAD DIR NO.
	MOVEI A,IUSRNM		;POINT TO DEFAULT DIR.
CPFN1:	MOVEI B,100000		;
	SKIPE A			;
	HRLI A,<POINT 7,0,-1>B53 ;IF NON-0, FILL OUT BYTE PTR
	MOVEM A,CJFNBK+3	;DEFAULT DIRECTORY
	MOVE A,[XWD -2,[ASCIZ /SAV/]]
	JRST CFN1A		;JOIN CINFN & COUTFN

;TYPIF: TYPE NAME OF CURRENT FILE IN INPUT FILE GROUP
; BUT NOT IF NOT A GROUP (IE ONLY ONE NAME AND NO *'S INPUT)
;RETURNS JFN IN A

TYPIF::	HRRZ A,@INIFH1		;GET CURRENT JFN
	TLNE Z,GROUPF		;SKIP IF NON-GROUP
	ETYPE < %1S
>;		;%S: TYPE NAME FOR JFN
	RET

;GNFIL
;GET NEXT INPUT FILE OF GROUP WHICH MAY CONTAIN *'S OR MULTIPLE NAMES.
;R1 IF NO MORE FILES. R2 WITH NEXT JFN IN A.
;CLOSES PREVIOUS FILE IF OPEN. DOESN'T RELEASE JFN (RLFJNS DOES THIS).

GNFIL::	PUSH P,A
	PUSH P,B
	HRRZ A,@INIFH1
	GTSTS
	JUMPGE B,GNFIL3		;JUMP IF NOT OPEN
	TLO A,B0		;SAY DON'T RELEASE JFN
	CLOSF
	 CALL JERR
GNFIL3:	MOVE A,@INIFH1
	TLNN A,<77B5>B53	;NO *-FLAGS, SKIP GNJFN AND ITS BUGS
	JRST GNFIL5
	CAME A,[-2]		;-2 MEANS "NO FILES AT ALL" IN CERTAIN CASES
				;(THAT SHOULDN'T GET HERE ANYWAY)
	GNJFN			;STEP TO NEXT FILE IN *-GROUP
	JRST GNFIL5		;NO MORE
	JRST GNFIL8
GNFIL5:	AOS A,INIFH1		;NEXT NAME IN GROUP
	CAMLE A,INIFH2		;ARE THERE MORE?
	JRST [	POP P,B		;NO
		POP P,A
		RET]
GNFIL8:	HRRZ A,@INIFH1		;RETURN NEXT JFN IN A
	AOS -2(P)
	POP P,B
	SUB P,[XWD 1,1]
	RET

;FRSTF AND NEXTF: ROUTINES FOR STANDARD USE OF INPUT FILE GROUP.
;CALL FRSTF BEFORE PROCESSING A FILE.
;  IT TYPES NAME IF A GROUP IS BEING PROCESSED.
;AFTER PROCESSING FILE, JRST NEXTF.
; IF NO MORE FILES IN GROUP, GOES TO RLJFNS WHICH RETURNS TO COMMAND
;	INPUT OR ANY OTHER ADDRESS WHICH HAS BEEN PUSHED.
; OTHERWISE, GETS HEXT JFN IN A, TYPES NEXT FILE NAME, AND RETURNS
;	WHERE FRSTF LAST RETURNED. BEWARE OF PD LEVEL CHANGES!

FRSTF::	POP P,FRSTFR		;SAVE RETURN FOR CALLS TO NEXTF
FRSTF1:	CALL TYPIF		;TYPE FILE NAME IF GROUP
	PUSH P,FRSTFR		;RETURN
	RET

NEXTF::	CALL GNFIL		;NEXT FILE IN GROUP
	JRST RLJFNS		;R1: NO MORE. FAILS IF GARBAGE IN PD!
	JRST FRSTF1

;DEVN
;INPUT AND VERIFY A DEVICE NAME.
;READS STRING, ACCEPTING ALT MODE (ECHO COLON), EOL, SPACE, COLON, SEMI
; AS TERMINATOR.
;DOES NOT DISTINGUISH PHYSICAL NAMES AND ALREADY-DEFINED SYNONYMS.
;RETURNS:
;  A:  DEVICE DESIGNATOR
;  B:  CHARACTERISTICS WORD AS RETURNED BY "DVCHR". HIGHLIGHTS THEREOF:
;	B5: ON IF AVAILABLE OR ASSIGNED TO THIS JOB
;	B6: ON IF ASSIGNED
;	    BOTH B5 & B6 ON IF ASSIGNED TO SELF
;  C:  JOB # ASSIGNED TO IF B6 OF B ON

;ENTRY

DEVN::
;RETURN HERE TO TRY AGAIN AFDER TYPING " ? " AFTER ERROR.

DEVN1:	TLO Z,PUNCF
	INHELP <Device name>
	ALLOW TALT+TEOL+TSPC+TCOL
	PUSH P,CSBUFP		;SAVE POINTER INTO SPACE "BUFFF" USES
	CALL BUFFF		;BUFFER IT WITH NULL TERMINATOR, RET PTR IN A
	STDEV		;STRING TO DEVICE DESIG CONVERSION
	 JRST DEVNE
		;DESIGNATOR NOW IN B
		;NEED WE CHECK FOR WHOLE STRING USED?
	POP P,CSBUFP		;RECLAIM SPACE IN BUFFER USED BY "BUFFF"
	CAIN TRM,ALTM
	CALL UBP		;REMOVE ALT MODE FROM COMMAND STRING BUFFER
	ALTYPE <: >
	MOVE A,B
	DVCHR		;GET CHARACTERISTICS WORD
	HLRE C,C
	RET

;ERROR RETURN FROM "STDEV".

DEVNE:	POP P,CSBUFP		;RECLAIM SPACE IN STRING BUFFER USED BY "BUFFF"
	MOVE A,B		;MOVE ERROR CODE TO 1
	CAIE A,STDVX1		;"UNRECOGNIZED DEVICE"
	CALL JERR		;(4/13/70: NO ERRORS BUT STDVX1)
	TRNE CBT,TEOL
	JRST CERR		;AFTER CR, ABORT COMMAND.
	TYPE < ? >;		;OTHER TERMINATORS: " ? " AND RETRY.
	MOVE BFP,.BFP		;BACK UP PTR INTO COMMAND BUFFER
	BTCHER
	JRST DEVN1		;TRY AGAIN

;DIRNAM
;INPUT A DIRECTORY (INCLUDES USER) NAME, WITH RECOGINITION.
;RETURNS ENTIRE WORD FROM STDIR IN A, PTR TO BUFFERRED STRING IN B.
;USED IN CONNECT, WHERE, ^EPRINT COMMANDS.
;PRESERVES E (FOR DIRECTORY).

DIRNAM::
	MOVEI A,0		;0 MEANS NO DEFAULT
USER::
	PUSH P,C
	TLO Z,PUNCF
	INHELP <Directory name> ;READ NAME (REMEMBER "MORE" RETURNS HERE)
				;CALLER MUST CHECK TERMINATOR
	MOVEI B,(A)
	CALL BUFFF
	PUSH P,A
	CAIG CNT,1
	JUMPN B,[ALLOW TALT+TEOL
		PUSH P,B
		DIRST
		CALL SCREWUP
		IBP A
		MOVEM A,CSBUFP
		MOVE A,.BFP
		CALL $DIRST
		CALL SCREWUP
		MOVEM A,BFP
		TRNE CBT,TALT
		ETYPE <%2R>
		JRST USER5]
	CAIN TRM,ALTM
	CALL UBP		;REMOVE ALT MODE FROM BUFFER
	MOVE B,A
	MOVEI A,1		;SAYS NO RECOG
	TRNE CBT,TALT
	TLO A,400000		;ALT MODE: REQUEST RECOGNITION
	STDIR
	JUMPN CNT,CERR
	 JRST [	TRNN CBT,TALT	;AMBIGUOUS
		JRST CERR
		CALL DING
		MOVEI A,0
		SUB P,BHC+1
		JRST MORE]
	PUSH P,A		;SAVE WHAT STDIR RETURNED
	TRNN CBT,TALT
	JRST USER5
	IBP B
	EXCH B,CSBUFP		;UPDATE STRING POINTER
	MOVE A,B
	BKJFN			;DECREMENT OLD BYTE PTR
	 CALL JERR		;...TO GET TO APPENDED CHARS (OR NULL IF NONE).
	CALL $CTYPE		;ECHO AND BUFFER REST AFTER ALT MODE
USER5:
	POP P,A			;DIR # AND BITS FROM STDIR
;ALTYPE ( ) OR ALTYPE (>) MUST FOLLOW IN CALLING ROUTINE
	POP P,B			;RETURN STRING POINTER
	POP P,C
	RET

;DEFDIR: INPUT A DIRECTORY NAME.  DEFAULT TO SELF

DEFDIR::
	MOVE A,CUSRNO		;PICKUP DIR NUMBER
	TLNN Z,BAKFF		;IS THERE AN UN-INPUT FIELD?
	TRNN CBT,TEOL		;GET DEFAULT?
	CALL USER		;INPUT A DIRECTORY NUMBER TO A
	ALTYPE ( )
	HRREI A,(A)
	SKIPG A			;IS HE LOGGED IN?
	ERROR <You are not logged in>
	RET

;INPUT A TTY NUMBER.

; MAYBE FROM USER NAME
; USED BY LINK, ADVISE

TTYNUM::INHELP <One of the following:
Terminal number
User name>
	ALLOW TEOL+TSPC+TALT
	CALL BUFFF
	MOVEM P,FRAME		;SAVE BEGINNING OF POSSIBITITES
	MOVE B,.BFP		;GET 1ST CHAR
	ILDB A,B
	MOVE C,CHRTBL##(A)
	TRNE C,OCTDIG
	JRST TTYN10		;TAKE AS TTY#

TTYN1:	TLO Z,BAKFF		;REUSE FIELD
	CALL DIRNAM		;INPUT AS USER NAME
	TLNE A,B0
	JRST CERR		;CAN'T LINK TO FILES ONLY DIR.
	ALTYPE ( )
	ALLOW TEOL+TSPC+TALT
	CONFIRM
	MOVEM A,DIRNO

TTYN2:	MOVEM P,FRAME		;SAVE BEG OF ARGS
	MOVE A,['JOBDIR']
	SYSGT
	HLLZ D,B		;MAKE AOBJN PTR
	MOVEI E,0(B)
TTYN3:	GTB 0(E)
	XOR A,DIRNO
	MOVEI A,(A)
	JUMPN A,TTYN6		;WRONG GUY
	HRLZ A,D
	GETAB
	 CALL JERR
	MOVEI B,0(D)
	JUMPE B,TTYN6		;IGNORE JOB0
	JUMPL A,TTYN6		;AND DETACHED JOBS
	HLRZS A
	PUSH P,A		;SAVE TTY# (1ST WORD OF A POSSIBILITY)

TTYN4:	MOVE A,['JOBNAM']
	SYSGT
	SKIPN A,B
	 JRST TTYN5
	HRL A,D
	GETAB
	 CALL JERR
	MOVE C,A
	MOVE A,['SNAMES']
	SYSGT
	SKIPN A,B
	 JRST TTYN5
	HRL A,C
	GETAB
	 CALL JERR

TTYN5:	PUSH P,A		;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
TTYN6:	AOBJN D,TTYN3		;MAY HAVE MORE JOBS
	CAMN P,FRAME		;FOUND ANY?
	 ERROR <Not logged in>
	POP P,A			;SUBSYSTEM NAME
	POP P,B			;TTY#
	CAMN P,FRAME		;ONLY ONE POSSIBILITY?
	JRST [	MOVE A,B	;YES, USE IT
		JRST TTYN11]

TTYN7:	MOVE C,B		;SAVE FOR POSSIBLE DEFAULT
	ETYPE < TTY%2O%, >
	JUMPE A,[PRINT "?"	;NO SUBSYS NAME
		JRST TTYN8]
	CALL SIXPRT##		;PRINT SUBSYSTEM

TTYN8:	PRINT EOL
	CAMN P,FRAME		;DONE ALL?
	 JRST TTYN9		;YES
	POP P,A
	POP P,B
	JRST TTYN7

TTYN9:	$TYPE < TTY:	>
	INHELP <Number>
	ALLOW TEOL+TSPC+TALT
	CAIN CNT,2
	 JRST [	MOVE B,.BFP	;ASKED FOR DEFAULT?
		ILDB B,B
		CAIE B,"-"
		 JRST .+1
		MOVE A,C	;NULL INPUT. USE FIRST JOB SEEN
		JRST TTYN11]

TTYN10:	TLO Z,BAKFF		;REUSE FIELD
	CALL OCTAL		;GOBBLE AS OCTAL NUMBER
	 JRST [	ALTYPE <->
		MOVE A,C
		JRST .+1]
	CONFIRM

TTYN11:	MOVE P,FRAME		;FLUSH BACK THE STACK
	PUSH P,A		;SAVE TTY#
	MOVE A,['TTYJOB']
	SYSGT
	CALL [	JUMPE B,JERR
		RET]
	HLRES B
	MOVMS B
	POP P,A			;TTY#
	CAIGE A,0(B)
	CAIGE A,0
	 ERROR <Non-existent terminal number>
	RET

;DATE AND TIME INPUT

;KWV1 MUST BE SET UP FOR "CONF" (0 OK). CLOBBERS A,B.
;DATE STRING IS PRE-READ BY EXEC (BECAUSE OF NOISE AND EDITING);
;IF DATE CONTAINS IMBEDDED SPACES, SEVERAL TRIES MAY BE NEEDED TO
;GET ENOUGH CHARACTERS.

DATEIN::TLO Z,PUNCF
	CALL CSTR
	AOS CNT		;MAKES BUFFF INCLUDE TERMINATOR
	CALL BUFFF
	SOS CNT
	SETZ B,		;FORMAT: NORMAL, FULLY GENERAL
	IDTIM		;INPUT AND CONVERT DATE AND TIME
	 CALL [		;IDTIM ERR RETURN: CODE IN B, STRING PTR IN A.
		EXCH A,B		;ERR CODE TO A (FOR JERR), STR PTR TO B
		;IF IT INPUT THE NULL, THEN IT NEEDS MORE CHARACTERS.
		CAIE A,DILFX1		;"ILLEGAL DATE FORMAT" ?
		CAIN A,TILFX1		;"ILLEGAL TIME FORMAT" ?
		JRST [	LDB B,B		;YES, GET LAST CHARACTER INPUT
			JUMPE B,[SUB P,[XWD 1,1]
				JRST MORE] ;GO BACK TO CSTR FOR MORE CHARS
			JRST CERR]	;ILLEG FORMAT B4 USING ALL CHARS
		CAIE A,DATEX3		;BAD DAY OF MONTH (EG FEB 30)
		CAIN A,DATEX5		;OUT OF RANGE (EARLY 1858 OR LATE 2576)
		JRST CERR		;"?"
		JRST JERR]		;GENERAL JSYS ERROR RETURN ROUTINE
	IBP A		;STEP STRING POINTER PAST THE NULL
	CAME A,CSBUFP		;ENTIRE STRING USED BY IDTIM?
	JRST CERR		;NO, TRAILING GARBAGE, ERROR.
	ALLOW TSPC+TALT+TEOL
	CONFIRM		;CHECK TERMINATOR, INPUT CR IF NECESSARY
	MOVE A,B		;DATE & TIME IN INTERNAL FORMAT
	RET

SHTIME::
	SETZ D,			;FLAG FOR 'MORE'
	INHELP < Daytime or Time%Y%>
	TRNE CBT,TCOL
	JRST MORE
	JUMPN D,SHTI2
	TRNE CBT,TEOL
	JRST SHTI1
	ALLOW TALT!TSPC
	ALTYPE ( )
	MOVE A,.BFP
	MOVSI B,(1B6)		;DON'T ALLOW TIME INPUT
	IDTNC
	JRST SHTI1		;GO TRY TIME ONLY FORMAT
	MOVE D,.BFP
	MOVE .BFP,BFP
	SETZ CNT,
	JRST MORE

SHTI1:
	MOVE A,.BFP
	MOVSI B,(1B0)		;TIME ONLY
	IDTNC
	 JRST CERR		;(OOPS!)
	MOVE A,D
	SETO B,
	SETZ D,
	ODCNV
	HRRI D,(A)
	IDCNV
	JRST CERR
	GTAD
	CAML A,B
	ADD B,[1,,0]
	MOVE A,B
	RET

SHTI2:
	ALLOW TALT!TSPC!TEOL
	ALTYPE ( )
	MOVE A,D
	SETZ B,
	IDTNC
	JRST CERR
	IDCNV
	JRST CERR
	MOVE A,B
	RET

;"OCTAL": 18-BIT OCTAL NUMBER INPUT AND CONVERSION
;"BIGOCT": 36-BIT OCTAL
;"DECIN": 36-BIT DECIMAL MAGNITUDE
;ALL RETURN VALUE IN A, TERMINATING CHARACTER IN "TRM".
;NO SKIP IF NULL INPUT.
;ERROR IF NON-DIGIT NON-TERMINATOR SEEN, OR IF OVERFLOW.
;ALLOWS ANY NON-ALPHNUMERIC AS TERMINATOR. CALLER MUST CHECK!
;DO NOT MAKE THIS A MONITOR FUNCTION BECAUSE OF DIFFICULTY OF
;  CAPTURING EXACT INPUT STRING FOR ^R.

DECIN::	PUSH P,F		;ENTRY FOR 36-BIT DECIMAL MAGNITUDE
	INHELP <Number>
	MOVEI F,^D10
	JRST INCON1

BIGOCT::INHELP <36-bit octal number>;ENTRY FOR 36-BIT OCTAL MAGNITUDE
BIGOC1:	PUSH P,F
	MOVEI F,10
INCON1:	PUSH P,B		;ENTRY FOR 36-BIT MAGNITUDE OF BASE IN F
	PUSH P,C
	PUSH P,D
	PUSH P,E
	MOVE D,.BFP
	HRREI C,-1(CNT)
	SETZ A,
	JUMPLE C,OCTAL7		;NULL INPUT
	TLZ Z,F3		;NO MINUS SIGN SEEN
	ILDB E,D		;GET FIRST CHAR
	CAIE E,"-"
	JRST OCTAL3		;NOT MINUS, GOBBLE NUMBER
	TLO Z,F3		;SAY NEGATION NEEDED AT END
	SOJLE C,OCTAL7		;NULL, EXCEPT FOR - SIGN
OCTAL2: ILDB E,D
OCTAL3:	CAIGE E,"0"(F)
	CAIGE E,"0"
	JRST CERR		;NON-DIGIT, NON-BLANK
	MUL A,F
	LSH B,1
	LSHC A,-1
	ADDI B,-60(E)
	JUMPN A, CERR		;OVERLFLOW
	MOVE A,B
	SOJG C,OCTAL2
	TLNE Z,F3
	MOVNS A			;RETURN NEGATIVE NUMBER IF - SEEN
	ALTYPE ( )
	AOS -5(P)
OCTAL7: POP P,E
	POP P,D
	POP P,C
	POP P,B
	POP P,F
	RET

OCTAL::	INHELP <18-bit octal number>;ENTRY FOR 18 BITS OCTAL (FOR ADDR)
	CALL BIGOC1
	RET
	TLNE A,-1
	JRST CERR
	AOS (P)
	RET

;"OCTCOM": 36-BIT OCTAL INPUT CONVERSION,
;ALLOWING ONE FIELD, OR TWO 18-BIT HALF-WORDS SEPARATED BY
; SPACE, ALT MODE, COMMA, OR TWO COMMAS.
;TERMINATORS ACCEPTED: ALT MODE, SPACE, EOL.
;CAN READ FIELD AFTER VALUE, HENCE GENERALLY ONLY VALID IF NUMBER
; IS LAST FIELD IN COMMAND.

OCTCOM::CALL BIGOCT		;GET WHOLE VALUE OR LH
	 RET		;NULL, GIVE RETURN 1
	PUSH P,A		;VALUE IN PUSHDOWN
	TRNE CBT,TEOL
	JRST OCCOM8		;EOL ENDS IT - ANOTHER HALF NOT ALLOWED.
	TRNN CBT,TALT+TSPC
	JRST OCCOM3
;AFTER SPACE OR ALT MODE PERMIT RH.
	CALL OCTAL		;OPTIONAL 18-BIT VALEE FOR RH
	 JRST [ 	TLO Z,BAKFF		;NULL FIELD, BACKUP & RETURN
		JRST OCCOM8]
	JRST OCCOM5
OCCOM3:	ALLOW TCOM
;AFTER COMMA ALLOW ANOTHER AND REQUIRE RH
	CALL OCTAL
	 JRST [	ALLOW TCOM		;NULL, NOT OCTAL, HAS TO BE 2ND COMMA.
		CALL OCTAL		;NOW RH IS MANDATORY
		 JRST CERR
		JRST .+1]
;HAVE RH IN A. CHECK TERMINATOR, COMBINE

OCCOM5:	ALLOW TEOL+TSPC+TALT
	EXCH A,(P)
	TLNE A,-1
	JRST CERR		;MORE THAN 18 BITS IN LH
	HRLM A,(P)		;COMBINE IN PUSHDOWN
OCCOM8:	POP P,A		;RETURN VALUE IN A
	AOS (P)		;SKIP
	RET

;OUTPUT OCTAL NUMBER FROM B, NO LEADING ZEROES OR SPACES.

TOCT::	PUSH P,A
	PUSH P,C
	MOVE A,COJFN		;DESTINATION
	MOVE C,[1B0+10]		;"MAGINITUDE" FLAG AND RADIX
	NOUT
	 CALL JERRC		;GENERAL JSYS ERROR, CODE IN C
	POP P,C
	POP P,A
	RET

;BUFFF
;SUBROUTINE TO BUFFER LAST FIELD IN A MANNER SUITABLE FOR JSYS'S AND
;  RETURN A BYTE PTR TO IT IN A.
;COPIES TO SEPARATE BUFFER SPACE, PUTS NULL BYTE AT END.

;BUFFS IS THE SAME AS BUFFF BUT THE STRING SOURCE IS SUPPLIED IN B

BUFFS::	PUSH P,B
	JRST BUFF0

BUFFF::	PUSH P,B
	MOVE B,.BFP

BUFF0:	PUSH P,C
	PUSH P,D
	MOVE A,CSBUFP		;STRING BUFFER POINTER
	MOVEI C,^D8(A)		;POINTER + MAX STRING LENGTH
	CAIL C,CSBUFE		;COMPARE TO BUFFER END
	ERROR <Overflow of EXEC's string storage area>
	MOVE C,CNT
	CAILE C,^D40		;THIS HELPS PROTECT AGAINST CSBUF OVERLFOW
	ERROR <Word too long>
	SOJLE C,BUFFF2		;COUNT IS 1 FOR NULL FIELD
BUFFF1:	ILDB D,B
	CAIL D,141		;ASCII LOWER CASE A
	CAILE D,172		;..Z
	JRST .+2
	SUBI D,40		;TRANSLATE LOWER CASE TO UPPER
	CAIN D,CONTCH		;SPECIAL CHARACTER STORED WHEN "&" INPUT FOR
	MOVEI D," "		;..LINE CONTINUATION. TRANSLATE IT TO SPACE.
	IDPB D,A
	JUMPE D,BUFFF3		;STOP ON NULL
	SOJG C,BUFFF1		;OR IF ALL CHARACTERS MOVED
BUFFF2:	SETZ D,
	IDPB D,A		;TERMINATE WITH NULL
BUFFF3:	EXCH A,CSBUFP
	POP P,D
	POP P,C
	POP P,B
	RET

;SUBROUTINE TO SET BREAK SET TO "ANY CHARACTER"

ALLBK::	PUSH P,C
	MOVEI C,17
	JRST BRKST1

;SUBROUTINE TO SET BREAK SET TO WAKE UP ON NON-ALPHANUMERICS

NALNBK::PUSH P,C
	MOVEI C,16
BRKST1:	PUSH P,A		;ENTRY TO SET BREAK SET BITS FROM C
	PUSH P,B
	MOVE A,CIJFN
	RFMOD		;READ TELETYPE MODE WORD
	DPB C,[POINT 6,B,23]		;NEW BREAK SET BITS
	SFMOD		;SET MODE WORD
	POP P,B
	POP P,A
	POP P,C
	RET

;SUBROUTINE TO TURN OFF ECHOING BEFORE PASSWORD INPUT

NOECHO::PUSH P,C
	TLO Z,NECHOF		;SAY ECHOING OFF (TESTED IN %NOI)
	MOVEI C,0		;SAY NO ECHOING NOHOW
	JRST ECHOST		;JOIN "DOECHO"

;SUBROUTINE TO TURN ON ECHOING AFTER PASSWORD INPUT

DOECHO::PUSH P,C
	TLZ Z,NECHOF		;SAY ECHOING NOT SUPPRESSED
	MOVEI C,2		;SAY IMMEDIATE OR DEFERRED ECHOING
ECHOST:	PUSH P,A		;ENTRY TO SET ECHO BITS FROM C
	PUSH P,B
	MOVE A,CIJFN
	RFMOD		;READ TELETYPE MODE WORD
	DPB C,[POINT 2,B,25]
	SFMOD		;SET TTY MODE WORD
	POP P,B
	POP P,A
	POP P,C
	RET

;SUPPRESS EOL ECHOING: CHANGE CONTROL CHARACTER OUTPUT CONTROL
;BITS SO EOL'S DON'T PRINT.

NOECEO::PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVE A,COJFN
	RFCOC
	TRZ B,3B21+3B27		;TURN OFF LF AND CR
	TRZ C,3B27		;TURN OFF EOL
NOECE1:	SFCOC		;DOECEO JOINS HERE
	JRST [	POP P,C
		POP P,B
		POP P,A
		RET]

;TURN ON EOL ECHOING/PRINTING

DOECEO::PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVE A,COJFN
	RFCOC
	TLZ B,(3B15)
	TLO B,(2B15)		;TURN ON BELL
	TRO B,2B21+2B27		;TURN ON LF AND CR
	TRO C,2B27		;TURN ON EOL
	JRST NOECE1

;RFKTTM READ FORK TTY MODES
;FORK HANDLE OR NUMBER IN A

RFKTTM::
	PUSH P,A
	PUSH P,E
	TRZ A,.FH
	MOVEI E,SFKBLK		;SIZE OF FKBLK
	IMULI E,(A)		;DISPLACEMENT
	MOVE A,FKFLG(A)		;FORK FLAGS
	TLNE A,FK%BLK		;BLOCK OK
	CALL RTTYMD
	POP P,E
	POP P,A
	RET

;SFKTTM SET FORK TTY MODES
SFKTTM::
	PUSH P,A
	PUSH P,E
	TRZ A,.FH
	MOVEI E,SFKBLK		;SIZE OF FKBLK
	IMULI E,(A)		;DISPLACEMENT
	MOVE A,FKFLG(A)		;FORK FLAGS
	TLNE A,FK%BLK		;BLOCK OK
	CALL LTTYMD
	POP P,E
	POP P,A
	RET

;LTTYMD - LOAD TELETYPE MODES
;AC E CONTAINS A DISPLACEMENT FROM THE MFEXEC BLOCK

LTTYMD:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	SKIPN FK.MOD+0		;WILL BE 0 IF DETACHED (AUTOSTART)
	JRST LTTYM8		;SO JUST DO TIW AND SETNM
	MOVE A,COJFN
	SKIPN B,FK.MOD(E)	;FILE MODE WORD
	SKIPE B,FK.MOD		;USE EXEC'S IF NONE
	SFMOD
	MOVE B,FK.STP(E)	;3 TAB STOPS WORDS
	MOVE C,FK.STP+1(E)
	MOVE D,FK.STP+2(E)
	STABS
	MOVE B,FK.COC(E)	;2 CCOC WORDS
	MOVE C,FK.COC+1(E)
	SFCOC
LTTYM8:	MOVEI A,.FHSLF
	RPCAP
	JUMPGE C,LTTYM9		;CAN'T SET TIW IF NO ^C PRIV
	MOVEI A,.FHJOB
	MOVE B,FK.JTI(E)	;JOB TIW
	STIW
LTTYM9:	MOVE A,FK.SNM(E)
	SETNM			;SUBSYSTEM NAME
	JRST LRTTYM

;RTTYMD - STORE CURRENT TTY MODE, TAB STOPS, CCOC

RTTYMD:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	SKIPE FK.MOD		;RETURNING FROM DETACHED STARTUP?
	JRST RTTYM1
	GJINF			;YES
	CAMN 4,[-1]		;STILL DETACHED?
	JRST RTTYM9		;YES
	MOVEI 1,-1		;CONTROLLING TERMINAL
	RFMOD
;CHANGE APPROPRIATE BITS HERE
	MOVEM 2,FK.MOD
	STPAR			;PUT THEM INTO EFFECT (NEEDED ?)
RTTYM1:	MOVE A,COJFN
	RFMOD
	MOVEM B,FK.MOD(E)
	GTABS
	MOVEM B,FK.STP(E)
	MOVEM C,FK.STP+1(E)
	MOVEM D,FK.STP+2(E)
	RFCOC
	MOVEM B,FK.COC(E)
	MOVEM C,FK.COC+1(E)
	MOVEI A,.FHJOB
	RTIW
	MOVEM B,FK.JTI(E)
RTTYM9:	GETNM
	MOVEM A,FK.SNM(E)	;SIXBIT PROGRAM NAME
LRTTYM:	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET

;NOTE: ALL MODE STUFF IN EXEC IS DONE WITH OUTPUT FILE, WHICH IS
;LESS LIKELY TO BE REDIRECTED TO NON-TTY THAN INPUT.
;MODE IS UNLIKELY TO NEED CHANGING FOR NON-TTY INPUT FILE;

;INITIAL EXEC FORK STATE
INETTY::
NOSCRC <'MFEXEC'		;SIXBIT NAME>
SCRC <	'EXEC'			;SIXBIT NAME>
	0			;MODE WORD SAYS "DET" UNTIL WE GET A TTY
	1B0+1B8+1B16+1B24+1B32	;TABS
	1B4+1B12+1B20+1B28
	1B0+1B8+1B16+1B24+1B32
	BYTE (2) 0,0,1,1,1,0,0,2,0,2,2,1,1,2,1,1,1,1	;CCOC WORDS
	BYTE (2) 0,1,1,0,0,0,0,1,1,0,1,1,1,2,0,0,0,0
	-1			;INITIAL JOB TIW

   IFN .-INETTY-SFKBLK,<PRINTX INETTY TABLE INCORRECT LENGTH>

;INITIAL PROGRAM FORK MODES
INITTY::
	'(PRIV)'		;SIXBIT NAME
	0			;MODE WORD
	1B0+1B8+1B16+1B24+1B32
	1B4+1B12+1B20+1B28
	1B0+1B8+1B16+1B24+1B32
	BYTE (2) 0,0,1,1,1,1,0,2,1,2,2,1,1,2,1,1,1,1
	BYTE (2) 0,1,1,1,0,1,0,1,1,0,1,1,1,2,0,0,0,0
	-1			;PROGRAM INITIAL JOB TIW

   IFN .-INITTY-SFKBLK,<PRINTX INITTY TABLE INCORRECT LENGTH>

FKNNB0::XWD EOLOK+1,0		;SECOND WORD OK, FORK 0
	FH%MF			;PRIVILAGE REQUIRED (PROGRAM SETTABLE)

FKNNB::				;NAME TO NUMBER TABLE (KEYWORD VALUE)
REPEAT NFKS,<
XWD EOLOK,.-FKNNB>		;BITS,,FORK NUMBER

;UUO TO OUTPUT SINGLE ASCII CHARACTER FROM EFFECTIVE ADDRESS

%PRINT::PUSH P,A
	PUSH P,B
	AOS TTYACF		;TELL AUTOLOGOUT CODE THAT TTY IS ACTIVE
	MOVE A,COJFN
	HRRZ B,40
	CAIN B,37		;TENEX EOL?
	 JRST [	MOVEI 2,CR
		BOUT
		AOS TTYACF
		MOVEI 2,12
		JRST PRIN1]	;THAT OUGHT TO KEEP THE FTP GUYS HAPPY
PRIN1:	BOUT
	AOS TTYACF		;AGAIN, MAYBE BLOCKED DUE TO FULL BUFFER
	POP P,B
	POP P,A
	RET

;SUBR TO OUTPUT CHARACTER FROM B.
;ALSO STORE IT IN CBUF (POINTER "CBP") IF FLAG "STCF" ON
;    (AS DURING PRINTING AFTER ALT MODE).
;TRANSLATES SPECIAL INTERNAL CHARACTER FOR LINE CONTINUATION BACK
; TO &-EOL-SPACE, AS REQUIRED FOR ^R AND ^A EDITING CHARACTERS.

CCHRO::	CAIN B,CONTCH		;CONTINUATION CHARACTER
	JRST [	UTYPE [ASCIZ /&
 /]
		RET]
	TLNN Z,STCF
	JRST COUTC
	PUSH P,B
	MOVEI B,(BFP)
	CAIL B,CBUFE
	ERROR <Command too long>
	POP P,B
	IDPB B,BFP
	AOJ CNT,

;FOLLOWS CCHRO...
;OUTPUT CHARACTER FROM B WITHOUT STORAGE FLAG TEST (USED?)

COUTC:	PUSH P,A
	AOS TTYACF		;TELL AUTOLOGOUTTTY IS ACTIVE
	MOVE A,COJFN      	;FILE NUMBER OF PRIMARY OUTPUT FILE
	BOUT
	AOS TTYACF
	POP P,A
	RET

;MAP A PAGE OF A FORK
;TAKES:	AC A:	AN ADDRESS IN THE PAGE, OR -1 TO CLEAR BUFFER
;	CELL "FORK": FORK HANDLE
;RETS:	AC A:	ACCESS AND EXISTENCE BITS IN B2-5, RH PRESERVED
;	BUFFER PAGEN: THE PAGE MAPPED

MAPPF::	PUSH P,C
	PUSH P,B
	PUSH P,A
	JUMPL A,MPPF1
	MOVEI A,0(A)
	CAIG A,17
	JRST MAPACS
	LSH A,-^D9		;SEPARATE PAGE #
	HRL A,FORK		;FORK HANDLE OF PAGE WE WANT
	SKIPGE FORK		;IS THERE A FORK?
	ERROR <No Program>;	;NO. (SHD ONLY OCCUR FOR CIFORK)
	TLO A,.FH		;SAY FORK HANDLE NOT JFN
MPPF1:	MOVEI B,PAGEN		;GENERATE DESTINATION PAGE IDENTIFIER
	LSH B,-^D9		;...MUST SHIFT AT RUN TIME CAUSE EXTERNAL
	HRLI B,.FHSLF		;...SAY THIS FORK
	HRLZI C,B2+B3+B4	;REQUEST ALL ACCESS, NORMAL DISPOSAL
	CAME A,NPAGE		;SAVE TIME IF ALREADY MAPPED
	PMAP			;MAP IT
	 ERJMP [SETZ B,
		JRST MPPF8]
	MOVEM A,NPAGE		;SAY ITS MAPPED
	CAME A,[-1]
	RPACS			;GET ACCESS/EXISTENCE OF MAPPED PAGE
MPPF8:	POP P,A			;RH A TRANSPARENT
	HLL A,B			;ACCESS IN LH A
	POP P,B
	POP P,C
	RET

;REFERENCE IS TO AN AC. READ ACS INTO PAGEN WITH "RFACS".
;IN THIS CASE CALLER MUST USE SFACS IF HE WISHES TO CHANGE A LOCATION.

MAPACS:	SETO A,
	CALL MAPPF		;UNMAP PAGE IN BUFFER, IF ANY.
	SKIPGE A,FORK
	ERROR <No Program>
	MOVEI B,PAGEN
	RFACS			;READ FORK ACS INTO "PAGEN"
	HRLZI B,B2+B3+B4+B5	;SIMULATE ALL ACCESS BITS
	JRST MPPF8

;LOAD SINGLE WORD FROM FORK, GIVEN ADDRESS IN A

LOADF::	CALL MAPPF
	TLNN A,B5
	ERROR <No such page>
	TLNN A,B2
	ERROR <Can't read that page>
	ANDI A,777
	MOVE A,PAGEN(A)
	RET

;STORE SINGLE WORD FROM B INTO FORK, ADDRESS IN A

STOREF::CALL MAPPF
	TLNE A,B5		;OK TO STORE IF PAGE NON-EXISTENT
	TLNE A,B3!B9		;OR IF WRITE ACCESS PERMITTED
	CAIA
	ERROR <Can't write into page>
	ANDI A,777
	MOVEM B,PAGEN(A)
	RET

;%GTB
;UUO TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE.
;TABLE # IN EFF ADDR, INDEX IN RH OF D, ONE RETURN WITH WORD IN A.
;TYPICAL USAGE: LH D CONTAINS AOBJN COUNTER, B AND C ARE FREE
;	FOR USE IN OTHER JSYS CALLS INSIDE LOOP.

%GTB::	HRL A,D
	HRR A,40
	GETAB
	 CALL JERR
	RET

;ERROR, PSEUDO-INTERRUPT, %-MESSAGE-TYPING STUFF

;ALL INTERRUPTS IN MFEXEC ON LEVEL 1, AND LEVEL 2 RUN TO COMPLETION
; EXCEPT FOR UNEXPECTED TRAPS -- TERMINATE EXECUTION WITH ERROR MESSAGE.
; THESE SHOULD BE REPORTED AS THEY MAY CAUSE FREE SPACE ASSIGNMENT PROBLEMS,
;AND OTHER ABNORMALITIES

;PSI ROUTINE FOR DATAPHONE CARRIER OFF (HANGUP).
;TERMINAL CODE ^D30, ASSIGNED TO CHANNEL 5, LEVEL 2.
;DETACHES JOB TO FREE UP DATAPHONE, KILLS JOB IF NOT LOGGED IN.

HUPSI::	CALL PSIACS
	 1B5			;DEFER CHANNEL 5 IF NOINT
	GJINF
	JUMPLE A,HUPSI5		;KILL JOB IF NOT LOGGED IN
	TLNE Z,LOGOFF		;INTERRUPT OUT OF LOGOUT CODE?
	JRST HUPSI5		;YES. JUST DO LOGOUT
	JUMPL D,HUPSI9		;DETACHED ALREADY, IGNORE IT.
	MOVEI A,-1		;REFERENCE CONTROLLING TTY EVEN IF
				;  IT'S NOT PRI I/O FILE
	RFMOD
	TRNE B,1B35
	JUMPL D,HUPSI9		;CARRIER NOT NOW OFF, IGNORE.
	DTACH			;DETACH CONTROLLING TERMINAL
	JRST HUPSI8		;WAIT FOR ATTACH
HUPSI5:	SKIPL D			;PRINT EOL IF ATTACHED
	PRINT EOL
	SETO A,			;NOT LOGGED IN, SAY SELF,
	LGOUT			;KILL JOB.
	 CALL JERR
HUPSI9:	RET			;RESTORE ACS AND DISMIS INTERRUPT

;HANGING UP ON LOGGED IN JOB RESULTS IN DETACH.
;IF JOB IS NOT REATTACHED WITHIN N MINUTES, IT IS LOGGED OUT

HUPSI8:	TIME
	MOVE 2,1
	ADD 2,[^D3600000]	;N = 60 MINUTES FOR NOW
HUPSI7:	PUSH P,2
	MOVEI 1,^D3000
	DISMS			;WAIT 3 SECONDS
	GJINF			;GET CONTROL TTY NOW
	TIME
	POP P,2
	JUMPGE 4,HUPSI9
	CAMGE 1,2		;WAITED N MINUTES?
	JRST HUPSI7		;NO, WAIT SOME MORE
	SETO A,			;YES, JOB IS DEFINED AS ABANDONED
	LGOUT			;SO LOG IT OUT
	 CALL JERR

IITPSI::CALL PSIACS
	 1B14			;DEFER CHANNEL 14 IF NOINT
	SKIPG A,CUSRNO
	JRST ALOGIT		;NOT LOGGED IN!
;	CALL IMAILC
;	CALL IALERC
;	CALL IPRINC
;	CALL IDOWNC
	MOVEI C,^D60
	RET ;JRST IITSET

ALOGIT:	SKIPG A,ALOFH		;AUTOLOGOUT STARTED?
	RET			;NO?
FEATUR -%IIT,<JRST AUTOLO>
FEATUR %IIT,<
	TIME
	SUB A,STRTIM
	IDIV A,B		;TO SECONDS
	CAIG A,AUTOL2		;MIN YET?
	JRST ALOGI1		;NOT YET!
	MOVE A,TTYACF		;ACTIVITY COUNT
	EXCH A,TTYCNT		;SAVE NEW COUNT
	CAMN A,TTYCNT		;DOES OLD COUNT MATCH?
	JRST AUTOLO		;LOGOUT
ALOGI1:	MOVEI C,AUTOL3
>;END COND 1

IITSET:	TIME			;GET CURRENT TIME
	IMULM B,C		;DELTA "TICKS"
	ADD A,C
	MOVEM A,ITIMER		;NEW WAKEUP TIME
FEATUR %IIT,<			;IIT SITE
	MOVEI A,.FHSLF		;THIS FORK
	MOVSI B,(1B14)		;IIT INTERRUPT CHANNEL
	IIT
>
	RET			;RESTORE AC'S AND DEBRK


;EXEC'S MAIN FORK JRST'S HERE,
;ALSO PSI FALLS INTO HERE, TO DO AUTOLOGOUT.
;MAKE CHECKS, TYPE MESSAGE, LOG JOB OUT.

AUTOLO::
	SETZM STRTIM		;BE SURE IT EVENTUALLY TAKES
	CIS			;DON'T LOGOUT IN INTERRUPT LEVEL
	GJINF			;GETS CONTROLLING TTY # IN 4
	JUMPLE A,.+2		;IF LOGGED IN?
	ERROR <Autologout while logged in?>	;OOPS
	CAMN D,[-1]		;-1 IF NONE (DETACHED)
	JRST AUTOL6		;DETACHED, TYPING MESSAGE WOULD HANG JOB.
				;CAN BE DETACHED IF DATAPHONE
				;HUNG UP AND CARRIER-OFF PSI
				;ISN'T FULLY PROCESSED,
				;OR IF ATACH HAS SOMEHOW FAILED TO
				;COMPLETE.
	CALL DOECEO		;MAKE EOL'S PRINT!
	TYPE <
 Autologout...Bye, Bye.
>
	MOVE A,COJFN
	DOBE			;MAKE SURE IT ALL TYPES (NEEDED?)
AUTOL6:	SETO A,			;SAY SELF
	LGOUT			;LOG JOB OUT
	 CALL JERR		;SHOULDN'T BE ABLE TO HAPPEN.

PSIRCC:	ADD P,BHC+3
	EXCH B,-3(P)		;SAVE B
	MOVEM C,-2(P)		;SAVE C
	MOVEM B,-1(P)		;SAVE RETURN
	MOVEM A,0(P)		;SAVE A
	MOVE A,COJFN
	RFCOC
	EXCH B,-3(P)		;SAVE FIRST CCOC, RESTORE B
	EXCH C,-2(P)		;AGAIN FOR C
	POP P,A			;RESTORE A
	JRST DOECEO		;MAKE BELLS AND EOL'S WORK

PSISCC:	EXCH B,-2(P)		;CCOC WDS SHOULD BE HERE
	EXCH C,-1(P)
	PUSH P,A
	MOVE A,COJFN
	SFCOC
	POP P,A			;RESTORE A
	POP P,B			;RETURN ADDRESS
	POP P,C			;RESTORE C
	EXCH B,0(P)		;SAVED B WITH RETURN
	RET


NOINTR::SKIPN NOINTM
	RET
	PUSH P,A
	PUSH P,B
	MOVEI A,.FHSLF
	MOVE B,NOINTM
	IIC			;CAUSE DEFERED INTERRUPTS TO HAPPEN
	POP P,B
	POP P,A
	RET

;PRINT THE SCHEDULED SHUTDOWN TIME
;AND EXPECTED RESTART TIME.
;FOR IITPSI AND SYSTAT

DWNTIM::MOVE 1,['SYSTAT']
	CALL $SYSGT
	JUMPE 2,[RET]		;TABLE DOES NOT EXIST?
	PUSH P,2		;TABLE NUMBER
	MOVSI 1,27		;SHUTDOWN TIME CELL
	HRR 1,2			;TABLE NUMBER
	GETAB
	JRST DWNTI9
	JUMPE 1,[SUB P,BHC+1
		RET]
	PUSH P,1
	CALL CRIF
	TYPE <Tenex will go down >
	MOVE 1,COJFN
	POP P,2
	MOVEM B,OLDDTM		;RECORD PRINTED DOWNTIME
NOIAC <	MOVSI 3,(1B1+1B3+1B6+1B10+1B12+1B17) >
IAC <	MOVSI	3,(1B1!1B3!1B6!1B8!1B10!1B12!1B17) >
	ODTIM
	MOVE 1,0(P)		;SYSTAT TABLE NUMBER
	HRLI 1,30		;RESTART TIME
	GETAB
	JRST DWNTI9
	MOVEM A,OLDUTM
	JUMPE 1,DWNTI5		;NO UPTIME DECLARED
	PUSH P,1
	TYPE < til >
	MOVE 1,COJFN
	POP P,2
NOIAC <	MOVSI 3,(1B1+1B3+1B6+1B10+1B12+1B17) >
IAC <	MOVSI	3,(1B1!1B3!1B6!1B8!1B10!1B12!1B17) >
	ODTIM
DWNTI5:	MOVE 1,0(P)		;SYSTAT TABLE #
	HRLI 1,31		;REASON FOR SHUTDOWN
	GETAB
	 JRST DWNTI9		;MAY HAPPEN ON OLD SYSTEMS
	MOVEM A,OLDWHY		;SAVE REASON FOR HALT
IAC <	ANDI	1,17		; LH HAS PERSON, OTHER BITS FROM SYSHLT
	CAIGE	1,5
	JRST	DWNTI8
	CAILE	1,15
	JRST	DWNTI8		; LIMITS ARE 5-15 OCTAL
	TYPE	<
 due to >
	MOVE	3,RSNTAB-5(1)	; GET MAIN REASON BLOCK
	LDB	2,[POINT 3,OLDWHY,31]	; GET SUB-REASON LOCATION
	UTYPE	@3(2)		; TYPE REASON
>
NOIAC <
	CAIN 1,5
	 TYPE <
 for preventive maintenance>
	CAIN 1,6
	 TYPE <
 for scheduled hardware work>
	CAIN 1,7
	 TYPE <
 for scheduled software work>
	CAIN 1,^D8
	 TYPE <
 for emergency restart>
>
IAC <
DWNTI8:	HLRZ	2,OLDWHY
	JUMPE	2,DWNTI9	; NO PERSON CLAIMED THIS ONE?
	ETYPE	< by %2R>	; SOMEONE DID, GOOD FOR HIM
>
DWNTI9:	SUB P,BHC+1
	PRINT EOL
	RET

IAC <
RSNTAB:	[[asciz /preventive maintenance/]
	 [asciz /software reload/]
	 [asciz /reload of (same) monitor/]
	 [asciz /reload of (new) monitor/]
	 [asciz |file system dump/refresh|]
	 [asciz /operations work/]
	 [asciz /operations initialization/]]
	[[asciz /hardware work/]
	 [asciz /hardware reconfiguration/]
	 [asciz /equipment move/]
	 [asciz /equipment test/]
	 [asciz /hardware repair/]]
	[[asciz /software work/]
	 [asciz /experimental monitor/]
	 [asciz /monitor debugging/]
	 [asciz /test of new monitor/]
	 [asciz /software initialization/]
	 [asciz /software integration/]]
	[[asciz /emergency restart/]
	 [asciz /software emergency reload/]
	 [asciz /hardware emergency reload/]]
	[[asciz /unscheduled power outage/]
	 [asciz /scheduled power outage/]
	 [asciz /environmental problems/]]
	[[asciz /software breakpoint/]
	 [asciz /software checkpoint/]]
	[[asciz /hardware failure/]
	 [asciz /CPU hardware failure/]
	 [asciz /memory hardware failure/]
	 [asciz /peripheral device failure/]]
	[[asciz /scheduled downtime/]
	 [asciz /scheduled holiday/]
	 [asciz /scheduled power off time/]
	 [asciz /network access exclusion/]]
	[[asciz /an unspecified reason/]]
>
IIDOWD:	ADD P,BHC+17		;GET ROOM FOR 15 AC'S
	MOVEM 16,0(P)		;SAVE AC16
	MOVEI 16,-16(P)
	BLT 16,-1(P)		;SAVE AC'S 0-15
	CALL DWNTIM
	MOVSI 16,-16(P)
	BLT 16,16		;RESTORE AC'S 0-16
	SUB P,BHC+17
	RET

;PSI ROUTINE FOR TERMINAL CHARACTER THAT PRINTS RUNTIME (^T)
;AND FORK STATUS.  CHANNEL 3, LEVEL 2

USEPSI::CALL PSIACS
	 1B3			;DEFER CHANNEL 3 IF NOINT
	CALL PSIRCC
USEPS1:	GTAD			;"NOW"
	CAMG 1,CTLIM0		;2ND ^T WITHIN 15 SEC?
	CAMG 1,CTLIM1		;AND AT LEAST A MIN SINCE LAST TYPEOUT?
	 JRST USEPS3		;NO

USEPS2:	MOVEI B,CTTIM1		;ONE MINUTE
	CALL TIMPSC##		;TAD IN 1 PLUS SECONDS IN 2
	MOVEM 1,CTLIM1		;CLOSEST TIME OF NEXT FULL TYPEOUT
	JRST USEPS4		;GO DO FULL TYPEOUT

USEPS3:	MOVEI B,CTTIM0		;SECONDS
	CALL TIMPSC##
	MOVEM 1,CTLIM0		;UPDATE 15 SECONDS BETWEEN ^T TIMER
	MOVE A,COJFN
	MOVEI B,BELL
	BOUT			;DING ONLY IF NO PRINTOUT
	JRST USEPS6		;AND SKIP FULL TYPEOUT

USEPS4:	TLNE Z,RUNF		;IS A FORK RUNNING?
	SKIPGE A,LFORK		;YES. IS HANDLE OK?
	JRST USEPS5		;NO
REPEAT 1,<;THIS CODE SHOULD BE MADE SMARTER
; IE IT SHOULD PROBABILITY FIND THE HIGHEST NON-FROZEN FORK
; THAT IS NOT IN A FORK WAIT.
	PUSH P,A		;FORK HANDLE
	MOVE A,CIFORK
	TRO A,.FH
	CAMN A,0(P)
	JRST USEP4A
	RFSTS
	HLRZS A
	TRZN A,(1B0)		;FROZEN OR
	CAIN A,4		; A FORK WAIT
	 JRST USEP4A		; USE LFORK
	MOVE A,CIFORK
	TRO A,.FH
	MOVEM A,0(P)
USEP4A:	MOVE A,0(P)
>;END OF DUMB CODE
	ETYPE < %1F:  >
	CALL FSTAT##
	POP P,A
	ETYPE < Used %1V/%V in %C
>
	CALL LAPRNT##
	PRINT EOL
	JRST USEPS6
USEPS5:	CALL LAPRNT##		;PRINT LOAD AV.  NEAR "RUNSTAT"
	ETYPE <, Used %V in %C
>
USEPS6:	CALL PSISCC
	RET

;REGULAR ERROR - SYNTAX OR OBVIOUS SEMANTIC ERROR

CERR::  $ERROR < ?>

FEATUR %CORECT,<
IACERR::SKIPN	DOCORR
	JRST	CERR
	SKIPE	SECURE		; IF SECURE,
	JRST	CERR		; DON'T BOTHER
	MOVE	1,.BFP			; ATTEMPT SPELLING CORRECTION
	MOVE	2,[440700,,CORCMD]
IELP:	ILDB	3,1
	JUMPE	3,IACER1
	CAMN	1,BFP
	JRST	IACER1
	CAIE	3,"<"		; IF A FILENAME PUNCTUATOR,
	CAIN	3,">"		; FORGET CORRECTION AND
	JRST	CERR		; JUST USE OLD ERROR ROUTINE
	CAIN	3,"."
	JRST	CERR
	CAIL	3,"a"
	CAILE	3,"z"
	TRNA
	TRZ	3,40			; RAISE LOWER CASE TO UPPER
	CAIL	3,"A"
	CAILE	3,"Z"
	JRST	IACER1
	IDPB	3,2
	JRST	IELP
IACER1:	SETZ	3,
	IDPB	3,2
	MOVE	1,[440700,,CORCMD]
	MOVEI	2,CTBL1##
	CALL	SPLCOR##
	JUMPE	3,CERR		; NO CLOSE COMMAND NAME FOUND
	HRRO	2,CTBL1(3)
	ETYPE	< [= %2W] >
	MOVE	1,.BFP
	PUSH	P,3
	SETZ	3,
	SOUT
	MOVE	2,TRM
	BOUT
	MOVEM	1,BFP
	POP	P,3
	HLRZ	3,CTBL1(3)
	MOVE	KWV,(3)
	MOVE	KWV1,KWV
	CAIN	TRM,EOL
	PRINT	EOL
	JRST	CIN2##
>
;NOT IMPLEMENTED YET ERROR

NIM::
NIYE::	ERROR <Not implemented yet>

;DING
;SUBROUTINE TO RING BELL, CLEAR INPUT BUFFER, STOP NON-INTERACTIVE JOB.
;USED AFTER RECOGNITION AMBIGUITIES AND SUCH ERRORS.

DING::	PUSH P,A
	MOVE A,CIJFN		;COMMAND INPUT FILE JFN
	CFIBF			;CLEAR INPUT BUFFER
	BTCHERR			;THIS SHOULD STOP NON-CONVERSATIONAL JOB
	PRINT BELL		;OUTPUT BELL
	POP P,A
	RET

;INTERNAL ERROR
SCREWUP::HRRZ E,(P)		;PC (GET HERE WITH PUSHJ)
	SUBI E,1
	ERROR <MFEXEC internal error at %5P  ACS %1O %2O %3O>

;ERROR RETURN FROM A JSYS, SYSTEM ERROR # IN 1.
;PRINTS SYSTEM MESSAGE AND GOES BACK TO COMMAND INPUT.
;MOST ERROR RETURNS WILL REQUIRE SOME SPECIAL CASE CHECKS
; BEFORE COMING TO THIS GENERAL ROUTINE.
;NOTE: ERROR NUMBER IN A IS USED INSTEAD OF -1 ARG TO "ERSTR"
; BECAUSE THIS ROUTINE IS ALSO USED WITH SUBROUTINES THAT SIMULATE
; JSYS'S. 6/26/70.

JERR::	MOVEM A,ERCOD		;SAVE ERROR NUMBER
JERR1:	CALL NOINTR		;PROCESS DEFERED INTERRUPTS AND
				; BE SURE INTERRUPTS ARE ACTIVE
	CALL ERFRST		;GET SET TO TYPE MSG
	CALL CRIF		;EOL UNLESS AT LEFT
	TYPE <JSYS error return in MFEXEC>
	    HRRZ F,(P)		;PC (GOT TO JERR WITH PUSHJ)
	    SUBI F,2		;PROBABLE LOC OF JSYS
	    PRINT EOL
	    ETYPE < PC %6P  ACs %1O %2O %3O>
	JRST SYSERA		;GO TYPE SYSTEM ERROR MESSAGE

JERRC::	MOVEM C,ERCOD		;"JERR" FOR ERROR CODE IN C
	JRST JERR1		;  (AS AFTER "NOUT")

;ERROR PSEUDO-INTERRUPT ON LEVEL 1 UUO SERVICE ROUTINE
;DEBREAK IMMEDIATELY BECAUSE IF ANOTHER TRAP WERE TO OCCUR DURING
;THIS ONE, MONITOR MIGHT HAVE TROUBLE HANDLING IT.
;THEN TYPE TEXT EFF ADDR POINTS TO, "TRAP IN MFEXEC",
;  TYPE SYSTEM ERROR MESSAGE WITH
;  REGULAR ROUTINE, AND RETURN TO COMMAND INPUT.

%TRAP::	CALL CCOFF		;Turn off control C
	PUSH P,D
	PUSH P,E
	HRRZ E,LEV1PC		;GET PC OF ERROR
	CIS			;CLEAR THIS INTERRUPT,
				;ALSO CLEAR LOWER-LEVEL INTRPTS
				;SUCH AS ^T AND CARRIER-OFF.
				;NOPS IF NOT ON A PSI,
		;WHICH CAN HAPPEN VIA SPECIAL CASE IL INST STUFF.

	MOVE D,40		;SAVE TEXT ADDRESS
	CALL ERFRST		;DO THINGS NEEDED BEFORE TYPING MESSAGE
	CALL CRIF		;EOL IF CARRIAGE NOT AT LEFT MARGIN
	UTYPE (D)		;TYPE CHANNEL-SPECIFIC MESSAGE
	TYPE < Trap in MFEXEC>
	   PRINT EOL
	    ETYPE < PC %5P%  ACs %1O %2O %3O>;
	POP P,E
	POP P,D
	JRST SYSERM		;GO TYPE SYSTEM ERROR MESSAGE.

;NOTE: IN MFEXEC THERE ARE NO ERROR INTERRUPTS WHICH DEBREAK TO THE POINT
;OF INTERRUPTION.  HENCE WE NEEDN'T WORRY ABOUT CELLS SUCH AS "RERET"
;BEING CHANGED.  BUT WE DO HAVE TO CODE ROUTINES SUCH AS "RLJFNS" TO
;WORK OK IF INTERRUPTED IN THE MIDDLE AND RESTARTED.

;CCOFF; TURN OFF CONTROL C AND SETUP TRAP HANDLER TO WORK IF
;TRAP WAS CAUSED WHILE HANDLING ^C.  USUALLY IS PDL OVERFLOW TRAP.

CCOFF:	PUSH P,A
	PUSH P,B
	TLZE Z,CTLCF1+CTLCF2
	SETZM ERRMF		;CAN HANDLE ERROR WHILE PROCESSING ^C
	MOVEI A,.FHSLF
	MOVSI B,(1B1)		;CONTROL C CHANNEL
	DIC
	MOVE B,RERET		;CHANGE ERROR ROUTINE RETURN
	MOVEM B,CERET		; TO REGULAR
	SETZM .JBUFP		;SAY FLUSH ALL JFNS
	POP P,B
	POP P,A
	RET

;ILLEGAL INSTRUCTION PSI, CHANNEL 15, LEVEL 1
;ANALYZES THE INSTRUCTION FOLLOWING THE INSTRUCTION THAT TRAPPED
;AND IF IT IS ONE OF THE SPECIAL ONES THEN DO THE SIMULATION.
;OTHERWISE HANDLE IT AS AN UNEXPECTED TRAP
;IF SPECIAL ROUTINE ISN'T INTERESTED IN THIS PARTICULAR ERROR,
; IT CAN JRST TO ILITRP.

ILIPSI::PUSH P,A
	HLRZ A,@LEV1PC		;GET FOLLOWING INSTRUCTION
	CAIE A,<ERJMP>B53
	CAIN A,<XJMP>B53
	JRST ILIPS2		;JUMP
	CAIN A,<ERCAL>B53
	JRST ILIPS1		;CALL
	POP P,A
ILITRP::TRAP <Illeg instruction>; ;NORMAL CASE.

ILIPS1:	MOVE A,LEV1PC
	ADDI A,1
	EXCH A,0(P)		;RESTORE A, PUSH PC
	PUSH P,A		;STACK IT AGAIN
ILIPS2:	MOVE A,@LEV1PC		;FULL INSTRUCTION
	EXCH A,0(P)		;RESTORE A, PUSH INSTRUCTION
	PUSH P,LEV1PC
	PUSH P,[ILIPS3]
	POP P,LEV1PC
	DEBRK			;DROP TO LEVEL THAT CAUSED TRAP
ILIPS3:	POP P,LEV1PC		;RESTORE OLD TRAP PC
	RET			;INTERPRET ERJMP OR ERCAL

;END-OF-FILE INTERRUPT, CHANNEL 10, LEVEL 1
;DEBREAK TO SPECIAL ROUTINE "EOFDSP" POINTS AT, OR,
; IF EOFDSP ZERO, TREAT LIKE OTHER ERROR PSEUDO-INTERRUPTS.
;"EOFDSP" IS NORMALLY ZERO BUT IS SET NON-0 FOR FILE-COPYING COMMANDS.

EOFPSI::SKIPE NOINTF
	JRST [	PUSH P,A
		MOVSI A,(1B10)
		IORM A,NOINTM	;SETUP A DEFERED MASK
		JRST EOFPSX]
	SKIPN EOFDSP
	TRAP <Unexpected end-of-file>; NO SPEC DISPATCH, TREAT AS ERROR
	PUSH P,A
	MOVE A,EOFDSP		;CHANGE INTERRUPT RETURN
	HRRM A,LEV1PC		;OLD PC IS LOST
	SETZM EOFDSP		;FUTHER INTERRUPTS ARE ERRORS
EOFPSX:	POP P,A
	DEBRK

;FILE DATA ERROR INTERRUPT, CHANNEL 11, LEVEL 1
;TYPES A MORE USER-ORIENTED MESSAGE THAN "TRAP" UUO.
;IF A COPY OPERATION, ETC, IS IN PROGRESS, IT GETS ABORTED AND
;  FILES ARE CLOSED, SO OUTPUT FILE IS TRUNCATED.

DATPSI::SKIPE NOINTF		;INTERRUPTS OFF?
	JRST [	PUSH P,A	;YES. SAVE AN AC
		MOVSI A,(1B11)
		IORM A,NOINTM	;SETUP DEFERED INTERRUPT
		POP P,A
		DEBRK]
	CIS
	MOVEI E,RERET
	MOVEM E,CERET		;REST ERROR RETURN TO "NORMAL"
	SETZM .JBUFP
	HRRZ E,LEV1PC
	ERROR <File data error, at MFEXEC PC %5P>;
		;SHOULD GET JFN (GETER?) AND PUT NAME IN ABOVE MESSAGE
		;AND ELIMINATE PC. ___________
		; PC IS GARBAGE IF INTERRUPT IS DEFERED!!!!_______

;SUPER-PANIC CHARACTER (CURRENTLY ^C) PSEUDO-INTERRUPT ROUTINE.
;CHANNEL 1, LEVEL 1

CCPSI::	TLOE Z,CTLCF1		;SAY WE'VE SEEN AN ^C
	TLON Z,CTLCF2		;IF ITS THE SECOND ONE, SAY SO
	SKIPA
	DEBRK			;Already have two control C's
	PUSH P,A
	PUSH P,B
	MOVEI A,.FHSLF
	MOVEI B,1B33		;SERVICE CHANNEL
	IIC
	POP P,B
	POP P,A
	DEBRK

;CONTROL C SERVICE ROUTINE (ENTER FROM SERVICE TRAP [CHANNEL 33, LEVEL 3])
CCFNC:	CIS
	MOVEI A,CCERET		;SET ERROR ROUTINE TO SPECIAL ^C VALUE
	MOVEM A,CERET		;..
	SETZM .JBUFP		;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND
	TLNN Z,RUNF		;DOES PROGRAM CONTROL TERMINAL MODES?
	JRST CCDB3		;NO.
	MOVE A,LFORK		;LAST PROGRAM RUN IS WHERE ^C CAME FROM
	MOVSI B,FK%ACT
	ANDCAB B,FKFLG-.FH(A)	;SAY FOR NO LONGER ACTIVE
	FFORK			;FREEZE THE WORLD
	TLNN B,FK%EPH		;IF NOT EPHEMERAL
	CALL RFKTTM		;STORE TTY MODES FOR "CONTINUE".
CCDB2:	TLZ Z,RUNF		;DON'T DO TTY MODES ON 2ND ^C!
CCDB3:	MOVEI A,.FHSLF		;PUT EXEC'S TTY MODES INTO EFFECT.
	CALL SFKTTM		;MUST ALWAYS BE DONE
				;EG GTJFN LEAVES THEM BAD.

CCDB4:
	SETZM ERRMF		;CLEAR "PROCESSING AN ERROR" FLAG
				;ANOTHER ^C WHILE PROCESSING 1ST IS OK

;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "^C", RELEASE JFNS, 
;AND GENERALLY CLEAN UP.
;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE.

	MOVE	A,COJFN
	TLNN	Z,CTLCF2	;2ND ^C?
	.$ERROR	<^C>		;NO. DON'T CLEAR INPUT BUFFER
	CFOBF			;CLEAR OUTBUFFER AND DO REG. ERROR
	$ERROR <^C>;		;AND CLEANUP

CCERET:	MOVE A,COJFN
	TLNN Z,CTLCF2		;BUT DON'T WAIT IF 2ND ^C
	DOBE			;2ND ^C MAY HAPPEN HERE
	TLZ Z,CTLCF1+CTLCF2
	JRST ERRET##		;RETURN TO COMMAND INPUT

;JSYS Trap interrupt routines, Channel 23., level 1

FEATUR %BAKTRP,<
JSYTRP::CALL	PSIACS
	 1B23
	RTFRK			; read trapped fork
	 CALL	JERR
	JUMPE	1,JSYTR0	; no fork trapped??
	MOVEM	1,JTDATA
	HLLI	1,		; get JSYS # in rh(1)
	CAIN	1,<777&GTJFN>
	JRST	.GTJFN
	CAIN	1,<777&AIC>
	JRST	.AIC
	CAIN	1,<777&DIC>
	JRST	.DIC
	CAIN	1,<777&ATI>
	JRST	.ATI
	CAIN	1,<777&DTI>
	JRST	.DTI
	CAIN	1,<777&STIW>
	JRST	.STIW
	CAIN	1,<777&RTIW>
	JRST	.RTIW
	CAIE	1,<777&PSOUT>
	CAIN	1,<777&PBOUT>
	JRST	[CALL	JCHPRO
		  JRST	JSYTR0
		 JRST	JISOUT]
	CAIN	1,<777&PBIN>
	JRST	[CALL	JCHPRI
		  JRST	JSYTR0
		 JRST	JISINP]
	CAIN	1,<777&ESOUT>
	JRST	[CALL	JCHPRO
		  JRST	JSYTR0
		 JRST	JISOUT]
	CAIE	1,<777&BIN>
	CAIN	1,<777&SIN>
	JRST	JCH1IN		; CHECK IF FORK'S AC1 = TTY
	CAIE	1,<777&IDTIM>
	CAIN	1,<777&NIN>
	JRST	JCH1IN
	CAIE	1,<777&FLIN>
	CAIN	1,<777&DFIN>
	JRST	JCH1IN
	JRST	JCH1OU

JSYTR0:	HLRZ	1,JTDATA
	UTFRK			; UNTRAP THE FORK
JSYTR1:	RET			; DEBREAK

JCHPRO:	HLRZ	1,JTDATA	; ROUTINE TO CHECK IF FORK'S PRIMARY OUTPUT
	GPJFN			;  FILE ISTHE TTY
	HRRZS	2
JCHPR1:	CAIN	2,-1
	JRST	JCHPR2
	CALL	JCHJFN
	 RET
JCHPR2:	AOS	(P)
	RET

JCHPRI:	HLRZ	1,JTDATA	; SAME BUT FOR PRIMARY INPUT
	GPJFN
	HLRZS	2
	JRST	JCHPR1

JCHJFN:	CAILE	2,MAXJFN	; CAN'T BE A JFN IF .GT. MAXJFN
	RET
	HRROI	1,JGTJST
	SETZ	3,
	JFNS
	MOVE	3,[ASCII /TTY:/]
	CAMN	3,JGTJST
	AOS	(P)
	RET

JCH1IN:	HLRZ	1,JTDATA
	MOVEI	2,JFRKAC
	RFACS
	HRRZ	2,JFRKAC+1	; GET FORK'S AC1
	CAIN	2,-1
	JRST	JISINP
	CAIN	2,100
	JRST	[CALL	JCHPRI
		 JRST	JSYTR0
		 JRST	JISINP]
	CALL	JCHJFN
	 JRST	JSYTR0
	JRST	JISINP

JCH1OU:	HLRZ	1,JTDATA
	MOVEI	2,JFRKAC
	RFACS
	HRRZ	2,JFRKAC+1
	CAIN	2,-1
	JRST	JISOUT
	CAIN	2,101
	JRST	[CALL	JCHPRO
		  JRST	JSYTR0
		 JRST	JISOUT]
	CALL	JCHJFN
	 JRST	JSYTR0
	JRST	JISOUT

JISINP:	HLRZ	A,JTDATA
	CALL	FFSUP
	MOVE	4,1
	MOVE	A,COJFN
	RFCOC
	PUSH	P,B
	PUSH	P,C
	CALL	DOECEO
	ETYPE	<
 [%4F wants TTY input]
>
	POP	P,C
	POP	P,B
	MOVE	A,COJFN
	SFCOC
	JRST	JSYTR1

JISOUT:	HLRZ	A,JTDATA
	CALL	FFSUP
	MOVE	4,1
	MOVE	A,COJFN
	RFCOC
	PUSH	P,B
	PUSH	P,C
	CALL	DOECEO
	ETYPE	<
 [%4F wants to do TTY output]
>
	POP	P,C
	POP	P,B
	MOVE	A,COJFN
	SFCOC
	JRST	JSYTR1

.GTJFN:	HLRZ	1,JTDATA
	MOVEI	2,JFRKAC
	RFACS
	MOVE	2,JFRKAC+1	; GET FORK'S AC1
	TLNN	2,(1B17)	; SHORT FORM GTJFN?
	JRST	GTJLNG		; NO
	TLNN	2,(1B16)	; JFNS IN AC2?
	JRST	JSYTR0		; NO, DON'T TRAP THIS GTJFN
	MOVE	4,JFRKAC+2
GTJTR0:	HLRZ	2,4		; EXAMIN JFNS
	CAIN	2,-1
	JRST	TRPGTJ
	CAIE	2,100
	JRST	GTJTR1
	CALL	JCHPRI
	 JRST	GTJTR1
	JRST	TRPGTJ
GTJTR1:	CALL	JCHJFN
	 JRST	GTJTR2
	JRST	TRPGTJ
GTJTR2:	HRRZ	2,4
	CAIN	2,-1
	JRST	TRPGTJ
	CAIE	2,101
	JRST	GTJTR3
	CALL	JCHPRO
	 JRST	GTJTR3
	JRST	TRPGTJ
GTJTR3:	CALL	JCHJFN
	 JRST	JSYTR0
	JRST	TRPGTJ

GTJLNG:	LDB	1,[POINT 9,JFRKAC+1,26]
	HLL	1,JTDATA
	MOVE	2,[.FHSLF,,GTJBUF/1000]
	MOVSI	3,(1B2!1B9)	; WITH R/CW ACCESS,
	PMAP			; GET FORK PAGE W/GTJFN BLOCK
	MOVES	GTJBUF		; MAKE OUR COPY PRIVATE
	LDB	1,[POINT 9,JFRKAC+1,35]
	MOVE	4,GTJBUF+1(1)	; GET JFNS WORD
	JRST	GTJTR0

TRPGTJ:	HLRZ	1,JTDATA
	CALL	FFSUP
	MOVE	4,1
	MOVE	A,COJFN
	RFCOC
	PUSH	P,B
	PUSH	P,C
	CALL	DOECEO
	ETYPE	<
 [%4F wants the TTY]
>
	POP	P,C
	POP	P,B
	SFCOC
	JRST	JSYTR1

FFSUP:	SETZM	FKSTCF		; MAKE SURE WE GET NEW STRUCTURE
	CALL	FNDFSB##
	CALL	FTPFKB##
	HRRZ	A,1(B)		; A NOW HAS HANDLE OF TRAPPED FORK'S
				; SUPERIOR (IF ANY)
	CAIN	A,.FHSLF	; IS IT US?
	HLRZ	A,JTDATA	; YES, USE THE FORK ITSELF
	MOVSI	B,FK%ACT
	ANDCAM	B,FKFLG-.FH(A)	; SAY IT'S SUSPENDED
	MOVSI	B,FK%TRP
	IORM	B,FKFLG-.FH(A)	; AND TRAPPED
	HLRZ	B,JTDATA
	MOVEM	B,FKTRAP-.FH(A)	; STORE HANDLE OF TRAPPED FORK
	CAME	A,B
	FFORK			; FREEZE FORK'S SUPERIOR, IF ANY
	RET

; MORE JSYS TRAP ROUTINES ON NEXT PAGE

; ROUTINES .STIW, .RTIW, .ATI, AND .AIC PERFORM LOGIC FOR MAKING SURE
; A BACKGROUND FORK NEVER GETS A TERMINAL INTERRUPT.  THE IDEA IS TO
; MAKE SURE THAT AT ALL TIMES, ONE OF THE FOLLOWING CONDITIONS IS TRUE
; FOR A BACKGROUND FORK: (1) THE FORK'S TIW IS ZERO, OR (2) ALL TERMINAL
; INTERRUPT CHANNELS ARE OFF.

; .STIW SIMULATES THE STIW JSYS BY STORING STIW'S ARGS FOR FUTURE
; RESTORATION AT FOREGROUND TIME.  MFEXEC DOES STIW FOR THE FORK, SETTING
; THE TIW TO ZERO.  FKTIW IS A BLOCK OF FORK TIW'S, AND FKDIM IS A BLOCK
; OF FORK DEFERRED INTERRUPT MASKS.

.STIW:	HLRZ	A,JTDATA
	MOVEI	B,JFRKAC
	RFACS			; GET FORK AC'S
	HRRZ	C,JFRKAC+1
	CAIE	C,.FHSLF	; FORK OPERATING ON ITSELF?
	JRST	JSYTR0		; NO, GIVE UP
	MOVE	C,JFRKAC+2	; GET FORK'S AC2 (NEW TIW)
	MOVEM	C,FKTIW-.FH(A)	; SAVE IT
	HLL	A,JFRKAC+1	; GET LH OF FORK'S AC1
	MOVE	C,JFRKAC+3	; GET FORK'S AC3
	TLNE	A,B0		; SET DEFERRED INTERRUPT MASK?
	MOVEM	C,FKDIM-.FH(A)	; YES
	SETZB	B,C
	STIW			; PERFORM THE STIW TO GET TIW=0
	HRRZS	A
	RFSTS
	HLRZ	A,JTDATA
	ADDI	B,1		; INCREMENT FORK'S PC TO SKIP THE STIW
	SFORK
	JRST	JSYTR0		; DONE

; .RTIW SIMULATES THE RTIW JSYS BY MERELY PROVIDING THE FORK WITH THE
; VALUES PREVIOUSLY STORED BY .STIW (OR WHEN THE FORK WAS INITIALLY
; MADE BACKGROUND, AT WHICH TIME THE TIW WAS ALSO STORED).

.RTIW:	HLRZ	A,JTDATA
	MOVEI	B,JFRKAC
	RFACS			; GET FORK AC'S
	HRRZ	C,JFRKAC+1
	CAIE	C,.FHSLF	; FORK OPERATING ON SELF?
	JRST	JSYTR0		; NO, GIVE UP
	MOVE	C,FKTIW-.FH(A)	; RETRIEVE STORED TIW
	MOVEM	C,JFRKAC+2	; PUT IT IN AC BLOCK
	MOVE	C,FKDIM-.FH(A)	; RETRIEVE STORED DIM
	MOVE	D,JFRKAC+1
	TLNE	D,B0		; GUY WANTED TO SEE DIM?
	MOVEM	C,JFRKAC+3	; YES
	SFACS			; GIVE NEW AC'S BACK TO FORK
	RFSTS
	HLRZ	A,JTDATA
	ADDI	B,1		; INC PC TO SKIP RTIW
	SFORK
	JRST	JSYTR0

; .ATI ALLOWS THE FORK TO PERFORM THE ATI JSYS (SINCE IT'S NECESSARY TO LET
; IT ASSIGN THE TERMINAL KEY TO THE CHANNEL), BUT FIRST STORES AWAY THE
; CHANNEL NUMBER BIT AND SHUTS OFF THE CHANNEL.  BLOCK FKCHAN CONTAINS A
; SET OF CHANNEL MASKS REPRESENTING CHANNELS WHICH MUST NOT BE ALLOWED TO
; ACTIVATE, SINCE THEY REPRESENT TERMINAL INTERRUPT CHANNELS.

.ATI:	HLRZ	A,JTDATA
	MOVEI	B,JFRKAC
	RFACS			; GET FORK AC'S
	HRRZ	C,JFRKAC+1	; GET CHANNEL NUMBER
	MOVNS	C		; NEGATE IT
	MOVSI	B,B0		; INITIAL CHANNEL MASK 1B0
	LSH	B,(C)		; FORM BIT MASK
	IORM	B,FKCHAN-.FH(A)	; TURN ON BIT IN SAVED CHANNEL MASK
	DIC			; SHUT OFF THE CHANNEL
	JRST	JSYTR0		; RETURN TO FORK'S ATI

; .DTI JUST TRAPS THE DTI JSYS IN ORDER TO REMEMBER THAT THE INDICATED
; KEYS ARE SUPPOSED TO BE OFF IN THE FORK'S TIW.

.DTI:	HLRZ	A,JTDATA
	MOVEI	B,JFRKAC
	RFACS
	HLRZ	C,JFRKAC+1
	MOVNS	C
	MOVSI	B,B0
	LSH	B,(C)
	ANDCAM	B,FKTIW-.FH(A)	; SHUT OFF BIT IN FORK'S STORED TIW
	JRST	JSYTR0

; .AIC PERFORMS THE AIC JSYS FOR THE FORK, FIRST MAKING SURE THAT NO
; TERMINAL INTERRUPT CHANNELS WILL BE ACTIVATED.

.AIC:	HLRZ	A,JTDATA
	MOVEI	B,JFRKAC
	RFACS			; GET FORK AC'S
	HRRZ	C,JFRKAC+1
	CAIE	C,.FHSLF	; FORK OPERATING ON ITSELF?
	JRST	JSYTR0		; NO, GIVE UP
	MOVE	B,JFRKAC+2	; GET FORK'S CHANNEL MASK
	ANDCM	B,FKCHAN-.FH(A)	; TURN OFF BITS FOR TERM INTERRUPT CHANS
	AIC			; DO THE AIC
	RFSTS
	HLRZ	A,JTDATA
	ADDI	B,1		; INC FORK PC TO SKIP AIC
	SFORK
	JRST	JSYTR0		; AND RETURN

; .DIC JUST TRAPS DIC IN ORDER TO REMEMBER WHICH CHANNELS ARE SUPPOSED
; TO GET TURNED OFF, SO MFEXEC CAN DO THE RIGHT THING AT FOREGROUND TIME.

.DIC:	HLRZ	A,JTDATA
	MOVEI	B,JFRKAC
	RFACS
	HRRZ	C,JFRKAC+1
	CAIE	C,.FHSLF
	JRST	JSYTR0
	MOVE	C,JFRKAC+2
	ANDCAM	C,FKCHN2-.FH(A)	; "TURN OFF" CHANS IN TABLE
	JRST	JSYTR0

> ; END OF %BAKTRP CONDITIONAL

;Fork termination interrupt. Channel 19 level 2

FKTPSI::CALL PSIACS
	 1B19			;DEFER CHANNEL 19 IF NOINT
	MOVE D,[XWD 1-NFKS,1]
FKTPS1:	MOVE C,FKFLG(D)
	TLNE C,FK%ACT
	CALL FKTERM
	AOBJN D,FKTPS1
	RET

FKTERM:	MOVEI A,.FH(D)		;MAKE FORK HANDLE
	RFSTS
	HRLI B,.FH(D)		;FORK HANDLE TO LH OF B
	CAMN A,[-1]		;NO SUCH HANDLE?
	JRST [	SETZM FKFLG(D)	;SAY IS DOESN'T EXIST
		RET]		;FORK KILLED BY SUPERIOR MAYBE
	HLRZ C,A		;FORK STATE
	TRZ C,B0		;CLEAR FROZEN BIT
	CAIL C,2		;NORMAL TERMINATION
	CAILE C,3		;FORCED TERMINATION
	 RET			;PROCESS STILL ACTIVE
	PUSH P,A
	MOVEI A,.FH(D)
	CAMN A,LFORK		;ONLY FORK WE WAIT ON
	TLNN Z,RUNF		;IS IT RUNNING
	FFORK			;FREEZE ALL BUT CURRENT RUNNING FORK
	MOVSI A,FK%ACT
	ANDCAM A,FKFLG(D)	;SAY NO LONGER ACTIVE
	POP P,A
	CAIN C,3
	JRST INVOLT

NORMT:	MOVE C,FKFLG(D)		;GET STATE BITS
	TLNN C,FK%BAK		;WAS IT A BACKGROUND FORK?
	RET			;NO.
	PUSH P,[[ASCIZ "%4F Halted"]]
	JRST FKTER1

INVOLT:	MOVE C,@WHY		;GET ERROR INSTRUCTION
	HRLI C,(POINT 7,0)	;MAKE IT A POINTER
	PUSH P,[[ASCIZ /%4F: %3W/]]
FKTER1:	PUSH P,A
	MOVSI A,5		;GET 5 WORDS FOR ETYPE BLOCK
	CALL ASNFRE
	 JRST [SUB P,BHC+2
		RET]		;FORGET IT
	POP P,1(A)
	MOVEM B,2(A)
	MOVEM C,3(A)
	HRRZM D,4(A)
	POP P,0(A)		;ETYPE STRING POINTER
	NOINT
	PUSH P,A
	HRLZS A			;BLOCK POINTER TO LEFT HALF
	HRRI A,ETQP		;ROUTINE TO RH
	CALL ENQ
	POP P,A
	CALL KEPFRE		;SAY BLOCK NOT TEMPORARY
	OKINT
	RET

;ENQ: PLACE DATA ON COMMAND QUEUE
;Data of form:
;   18-bit pointer/data,,routine to call with entry in A (AC1).

ENQ:	MOVEM A,@QIN
	AOS A,QIN
	CAIL A,Q+SQ
	MOVEI A,Q
	MOVEM A,QIN
	RET

;ETYPE QUEUE BLOCK
; LOC+0/ 0,,ETYPE STRING ADDRESS
;    +1/ AC1 VALUE
;    +2/ AC2 VALUE
;    +3/ AC3 VALUE
;    +4/ AC4 VALUE

;ETQP: ROUTINE TO PROCESS ETYPE QUEUED STRINGS
;  MUST BE CALLED NOINT
ETQP:	HLRZS A			;LEFT HALF HAS POINTER TO BLOCK
	HRLI A,(1B13)		;TURN ON INDIRECT BIT FOR ETYPE
	PUSH P,A
	MOVE D,4(A)		;MOVE IN AC VALUES
	MOVE C,3(A)
	MOVE B,2(A)
	MOVE A,1(A)
	UETYPE @0(P)		;OUTPUT STRING
	POP P,A
	HRLI A,5		;RELEASE THE 5 WORDS
	CALL RELFRE
	RET

;MESSAGE TABLE ADDRESSED BY FOLLOWING LOC ALSO USED BY "RUNSTAT".

WHY::	XCT .+1(A)		;ERROR MESSAGE FROM TABLE FOLLOWING
	ERROR <Chan %1Q interrupt at %2P>; CHAN 0. THESE HAPPEN IF
	ERROR <Chan %1Q interrupt at %2P>; PROGRAM ACTIVATES CHANNEL
	ERROR <Chan %1Q interrupt at %2P>; BUT DOES NO EIR OR SIR OR
	ERROR <Chan %1Q interrupt at %2P>; HAS 0 TABLE WD FOR CHANNEL.
	ERROR <Chan %1Q interrupt at %2P>; CHAN 4
	ERROR <Chan %1Q interrupt at %2P>; CHAN 5
	ERROR <Overflow at %2P>; CHAN 6. %2P => TYPE PC FROM RH B OCTAL
	ERROR <Floating overflow at %2P>; CHAN 7
	ERROR <Chan %1Q interrupt at %2P>; CHAN 8
	ERROR <Pushdown overflow at %2P>; CHAN 9
	ERROR <End-of-file at %2P>; CHAN 10
	ERROR <IO data error at %2P>;
	ERROR <Chan %1Q interrupt at %2P>; CHAN 12 "FILE CONDITION 3"
	ERROR <Chan %1Q interrupt at %2P>; CHAN 13 "FILE CONDITION 4"
	ERROR <Chan %1Q interrupt at %2P>; CHAN 14. TIME OF DAY.
	ERROR <Illeg inst %2X>; %X:INST "AT" PC, SYS MSG IF JSYS
	ERROR <Illeg mem read at %2P>
	ERROR <Illeg mem write at %2P>
	ERROR <Illeg mem xct at %2P>
	ERROR <Fork termination interrupt at %2P>; CHAN 19
	ERROR <System storage capacity exceeded at %2P>
	ERROR <Trap to user at %2P>
	ERROR <Non-existant page interrupt at %2P>
	 REPEAT ^D13,<ERROR <Chan %1Q interrupt at %2P>
>		;CHAN 23-35

;Function PSI service routine
;Channel 33 level 3

FNCPSI::CALL PSIACS
	 1B33			;DEFER CHANNEL 33 IF NOINT
	TLNE Z,CTLCF1		;^C
	JRST CCFNC		;PROCESS IT

FNCQP:	MOVE A,QOUT
	CAMN A,QIN
	 RET
	CALL FNCQP1
	JRST FNCQP

FNCQP1:	CALL PSIRCC		;SETUP CCOC'S FOR OUTPUT
	NOINT
	MOVE A,(A)
	CALL (A)		;CALL QUEUED ROUTINE
	AOS A,QOUT
	CAIL A,Q+SQ
	MOVEI A,Q
	MOVEM A,QOUT
	OKINT
	CALL PSISCC		;RESET CCOC'S TO ORIGINAL
				;MUST PUSHJ TO SETUP STACK CONTEXT
	RET

PSIACS:	EXCH A,0(P)
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,40		;UUO contents
	MOVE B,0(A)		;CHANNEL MASK
	SKIPE NOINTF		;ARE WE NOINT?
	JRST [	IORM B,NOINTM
		JRST .+3]	;FORGET IT FOR NOW
	ANDCAM B,NOINTM		;CLEAR ANY DEFERED FLAGS
	CALL 1(A)		;CALL ROUTINE AFTER FLAG WORD
	POP P,40		;Restore UUO contents
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	DEBRK

;ERROR UUO HANDLER. MESSAGE TEXT AT EFFECTIVE ADDRESS.
;SERVICES UUO'S UERR, U$ERR, U.$ERR (MACROS ERROR, $ERROR AND .$ERROR)

%ERR::
%$ERR:: TLZA Z,F1
%.$ERR::TLO Z,F1		;SAY DON'T CLEAR INBUF (ERFRS1)
	PUSH P,40		;TEXT ADDRESS AND UUO VALUE
	CALL ERFRS1		;SETUP BEFORE TYPING ERROR MSG
	JRST ERR1

;ENTER HERE TO TYPE SYSTEM ERROR MESSAGE FOR ERROR # IN "ERCOD"
;MUST HAVE ALREADY CALLED "ERFRST"

SYSERA:	PUSH P,[-2]
	JRST ERR1

;ENTER HERE TO TYPE MOST RECENT SYSTEM ERR MESSAGE

SYSERM:	PUSH P,[-1]		;INDICATE USE OF SYSTEM ERROR MESSAGE

;TYPE MESSAGE: CR FIRST UNLESS ALREADY AT LEFT, THEN SPACE (ALWAYS),
;THEN TEXT, THEN CR, BUT NO INITIAL CR-SPACE IF "U$ERR" UUO.

ERR1:	PUSH P,A		;AC'S MUST BE SAVED FOR ETYPE OR ERSTR
	PUSH P,B
	HLRZ B,-2(P)		;-2 FOR SYSTEM MSG, OR UUO FOR EXEC MSG
	CAIE B,<U.$ERR>B53
	CAIN B,<U$ERR>B53
	CAIA			;NO CR-SPC FOR U$ERR UUO ($ERROR MACRO)
	 CALL CRIF		;TYPE EOL IF NOT ALREADY AT LEFT
ERR5:	NOINT
	MOVEI A,.FHSLF		;OR EXEC IF NOT
	MOVE B,-2(P)		;0, -1, -2, OR UUO-TEXT ADDRESS
	JUMPG B,ERR5A		;PRINT ASCIZ TEXT SUPPLIED WITH UUO
	JUMPE B,ERR6		;PRINT NOTHING
	AOJE B,[CALL $GETER	;ERROR NUMBER TO B
		JRST ERR04]
	HRR B,ERCOD		;-2 SAYS USE SYSTEM ERR # FROM "ERCOD"
ERR04:	HRL B,A			;FORK HANDLE
	MOVE A,COJFN		;DESTINATION
	SETZ C,			;SAY PARAMETERS FROM PSB, NO LGTH LIMIT.
	ERSTR			;SYSTEM ERROR MESSAAGE TO STRING
	 JRST [	UETYPE [ASCIZ /Message not found for error %2P/]
		JRST ERR6]	;R +1: BAD ERROR #
	 JRST [	MOVEI A,.FHSLF	;R +2: DESTINATION PROBLEM,
		HFORK]		;HALT.
	 JRST ERR6		;R +3: DONE.

ERR5A:	MOVE B,0(P)
	MOVE A,-1(P)		;ETYPE USES VALUES THAT CAME IN AC'S
	UETYPE @-2(P)		;TYPE MESSAGE FROM CORE
ERR6:	OKINT
	PRINT EOL
	TLNE Z,LOGOFF
	TYPE < Not logged off
>;		;ERROR DURING LOGOUT, LIKELY AFTER "LOGGED OFF" MESSAGE

;ERROR UUOS AND SYSERM...
;MESSAGE ALL TYPED.

ERR7:	CALL DOECHO		;MAKE SURE ECHOING IS ON
	CALL RLJFNS		;CLOSE AND RELEASE ALL JFNS USED IN CMD
	PUSH P,C
	PUSH P,D
	HLRZ A,-4(P)		;-1 OR UUO
	TLNN Z,CTLCF1		;ALWAY CLEAR STUFF ON ^C
	CAIE A,<U.$ERR>B53	;DON'T CLEAR BUFFERS FOR .$ERROR

;CLEAR ALL PAGE WINDOWS, IE UNMAP PAGES OF OTHER FORKS OR FILES.
	JRST [	SETO A,		;PAGE OF INFERIOR FORK
		CALL MAPPF
		CALL UNMAP		;FLUSH BUFFER PAGES TOO
		JRST .+1]

	POP P,D
	POP P,C
	BTCHER			;SHOULD STOP NON-CONVERSATIONAL JOB
ERR8:	POP P,B
	POP P,A
	SUB P,BHC+1		;FORGET UUO
				;RESTORE EARLIER (LESS FULL) PLUSHDOWN
				;LEVEL IF LEVEL WAS SAVED IN ".P" .
				;THIS IS GENERALLY USED DURING
				;INPUT.
	SKIPE .P
	MOVE P,.P
	SETZM ERRMF		;NO LONGER PROCESSING AN ERROR
	JRST @CERET		;VARIABLE ERROR RETURN.  MAY GO SPECIAL
				;PLACES.  SUCH AS SUB-COMMAND INPUT FOR
				;"DIRECTORY" COMMAND.

;REGULAR ERROR RETURN - CERET USUALLY POINTS HERE

RERET::				;DO ANY OTHER CLEANING UP
	JRST ERRET##		;GO BACK TO COMMAND INPUT

;SUBROUTINE TO CALL BEFORE TYPING ANY ERROR MESSAGE TEXT
; OR EXECUTING ANY JSYS'S. MUST BE CALLED ONLY ONCE PER ERROR.

ERFRST:	TLZ Z,F1		;NORMAL ENTRY
ERFRS1:				;ENTER HERE TO NOT CLEAR INBUF IF F1 ON
	SKIPN CINITF		;IS EXEX INITIALIZED?
	HALTF			;NO, TYPING MESSAGE MIGHT FAIL & PRODUCE
				;INFINITE LOOP, SO JUST HALT.
	TLZ Z,BAKFF+STCF	;CLEAR FLAGS FOR:
				; REUSE SAME INPUT FIELD
				; STORE PRINTED CHARACTERS IN CMD BUFFER
	PUSH P,A
	PUSH P,B
	PUSH P,C

ERFRS2:	NOINT			;BE SURE ALL UPDATED SIMULTANEOUSLY
	MOVEI A,.FHSLF
	GPJFN
	SKIPGE CREDIF		;IF INPUT WAS REDIRECTED,
	HLRZM 2,CRJFNI
	MOVMS CREDIF		;UPDATE FLAG
	SKIPGE CREDOF
	HRRZM 2,CRJFNO		;SAVE FOR * OPTION OF "RED" AND "DET"
	MOVMS CREDOF
	MOVE 2,PRIMRY		;RESTORE JFNS WE HAD AT ENTRY
	SPJFN
;BE SURE ALL INTERRUPTS ARE NOW ENABLED AND ALL DEFERED INTERRUPTS
;ARE PROCESSED AT THIS POINT
	MOVEI A,.FHSLF
	SETZM NOINTF		;ENABLE INTERRUPTS
	SKIPE B,NOINTM		;DEFERED INTERRUPT CHANNELS
	IIC
ERFRS3:	CALL DOECEO		;MAKE SURE CCOC IS SUCH THAT EOLS PRINT
	SKIPE ERRMF		;ALREADY PROCESSING AN ERROR?
	JRST [	UTYPE [ASCIZ /
 Error within an error
/]		;YES, GIVE UP
		JRST ERRET##]
	SETOM ERRMF		;SAY PROCESSING AN ERROR
FEATUR %IIT,<MOVEI A,.FHSLF
	MOVSI B,(1B5)		;HANGUP CHANNEL
	SETZ C,
	IIT>			;CLEAR PROCEEDING INTERRUPT
	MOVE A,COJFN
	DOBE
	MOVE A,CIJFN
	TLNN Z,F1		;DONT CLR INBUF FOR RUBOUT, ^X (.$ERROR)
	CFIBF			;CLEAR FILE INPUT BUFFER
	POP P,C
	POP P,B
	POP P,A
	RET

;TYPE EOL UNLESS CARRIAGE IS ALREADY AT LEFT.

CRIF::	PUSH P,A
	PUSH P,B
	MOVE A,COJFN
	RFPOS			;READ FILE POSITION
	MOVEI B,(B)
	CAIL	B,2
	PRINT EOL
	CAIE	B,1		;IF ALREADY SPACED, DON'T SPACE AGAIN
	PRINT " "		;DON'T PRINT MSG IN COLUMN 0
	JRST [	POP P,B
		POP P,A
		RET]

;SUBROUTINE TO DO "GETER" JSYS AND PRESERVE AC'S 4-10.
;A MUST BE SET BY CALLER, RETURNS RESULT IN B.

$GETER::PUSH P,D
	PUSH P,E
	PUSH P,F
	PUSH P,G
	PUSH P,G+1
	GETER
	POP P,G+1
	POP P,G
	POP P,F
	POP P,E
	POP P,D
	RET

;RELEASE JFNS USED BY COMMAND BEING DECODED OR EXECUTED --
; USED AFTER ERRORS (%ERR) AND BY COMMAND EXECUTION ROUTINES.
;CLOSES AND RELEASES JFNS STACKED IN JBUF.
;EXCEPT DOESN'T GO BELOW CONTENTS OF ".JBUFP", WHICH IS NORMALLY 0
; BUT IS SET TO PRESERVE ASSIGNED JFN'S THRU ERRORS THAT RETURN
; TO A SUBCOMMAND INPUT LOOP.

RLJFNS::PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVE C,JBUFP

RJFNS1:	CAMLE C,[IOWD JBUFL,JBUF]	;STOP AT BOTTOM OF STACK,
	CAMN C,.JBUFP		;OR AT SAVED POINTER LEVEL
	JRST [	POP P,C
		POP P,B
		POP P,A
		RET]
;PROCESS ONE WORD OF JBUF
	HRRE A,(C)		;GET A JFN TO CONSIDER
	CAILE A,0
	CAILE A,MAXJFN		;IN RANGE?
	JRST RJFNS8		;NO.
	SKIPE B,CREDIF
	CAMN A,CRJFNI		;DON'T CLOSE SAVED INFILE
	JUMPN B,RJFNS8
	SKIPE B,CREDOF
	CAMN A,CRJFNO		;DON'T CLOSE SAVE OUTFILE
	JUMPN B,RJFNS8
	CALL CLSRLF		;Close and release it
;DONE WITH THIS WORD

RJFNS8:	SETZM (C)		;ZERO JBUF WORD
	SUB C,BHC+1		;DECREMENT POINTER
	MOVEM C,JBUFP
	JRST RJFNS1

CLSRLF::CAIL A,0		;Is JFN in range?
	CAILE A,MAXJFN
	RET			;No, just return
	CAIE A,100		;Don't release primary I/O
	CAIN A,101
	RET
	PUSH P,B
	GTSTS
	TLNN B,(1B10)		;Is JFN assigned?
	JRST CLSRL1		;No
	TLNN B,(1B0)		;Is it opened?
	JRST [	RLJFN		;No, just release it
		 CALL JERR
		JRST CLSRL1]
	CLOSF
	 CALL JERR
CLSRL1:	POP P,B
	RET

;%ETYPE (ETYPE MACRO, UETYPE UUO)
;HANDLER FOR UUO THAT TYPES MESSAGE, INTERPRETING % CODES.
;SPECIAL CODES ARE OF FORM %NL%
;	WHERE N IS AN OPTIONAL OCTAL NUMBER SPECIFYING AN AC
;	      L IS A LETTER:
;		D: TYPE CURRENT DATE
;		J: TYPE TSS JOB #
;		O: TYPE CONTENTS OF INDICATED AC IN OCTAL
;		SEE DISPATCH TABLE %LETS ON NEXT PAGE FOR FULL LIST.

%ETYPE::PUSH P,Z
	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	HRR A,40
	HRLI A,<POINT 7,0,-1>B53	;FORM BYTE PTR FROM EFF ADDR
ETYP2:	ILDB B,A			;NEXT CHARACTER
ETYP2A:	JUMPE B,[POP P,D		;NULL TERMINATES TEXT
		POP P,C
		POP P,B
		POP P,A
		SUB P,[XWD 1,1]		;FORGET SAVED Z VALUE
		RET]
	CAIE B,"%"
	JRST [	CALL CCHRO		;NOT A %, OUTPUT IT
		JRST ETYP2]

;%ETYPE...
;"%" SEEN

	SETZB C,D		;C: IF NO NUMBER, USE 0
				;D: INIT NUMBER TO 0.
ETYP4:	ILDB B,A		;CHARACTER AFTER %
	CAIG B,"9"
	CAIGE B,"0"
	JRST ETYP5
	IMULI D,10
	ADDI D,-"0"(B)		;ADD NEW DIGIT TO NUMBER
	MOVE C,D		;COMPUTE LOCATION TO GET AC FROM...
	CAIG C,D		;...AC'S 5-9 ARE PRESERVED,
	ADDI C,-4(P)		;...CONTENTS OF 0-4 ARE IN PUSHDOWN.
	MOVE C,(C)		;FETCH CONTENTS OF AC INDICATED BY NUMBER SO FAR
	JRST ETYP4		;GO CHECK FOR ADDITIONAL DIGIT(S)
ETYP5:	PUSH P,A		;SAVE BYTE PTR DURING PROCESSING
	CAIL B,"A"
	CAILE B,"Z"		;HIGHEST LETTER IN TABLE
	CALL UN%		;NOT LETTER, UNRECOGNIZED % CODE
	CALL @%LETS-"A"(B)	;DISPATCH WITH A PUSHJ THROUGH LETTER
				;TABLE.  AT THIS TIME C CONTAINS 0 OR
				;C(INDICATED AC).

;DONE INTERPRETING A % CODE.  MUST FOLLOW DISPATCH PUSHJ!

END%:	POP P,A			;GET TEXT POINTER BACK
	ILDB B,A		;NEXT CHARACTER
	CAIE B,"%"		;PASS FOLLOWING %
	MOVE A,1(P)
	JRST ETYP2		;CONTINUE TYPING

;%ETYPE...
;DISPATCH TABLE FOR LETTERS AFTER %

%LETS:	%A		;CURRENT TIME
	%B		;CPU TIME USED
	%C		;CONNECT TIME
	%D		;CURRENT DATE
	%E		;SAME TIME AS LAST %D
	%F		;"FORKNAME (N)" OR "FORK N"
	%G		;CONNECTED DIR NAME
	%H		;DEVICE NAME FOR DESIGNATOR IN INDICATED AC
	%I		;NUMBER OF LOGGED IN USERS
	%J		;TSS JOB #
	%K		;UPTIME
	%L		;"LINE N" OR "DETACHED"
	%M		;ACCT # OR STRING POINTER, AS FOR LOGIN
	%N		;NAME UNDER WHICH USER IS LOGGED IN
	%O		;CONTENTS OF SPECIFIED AC IN OCTAL
	%P		;CONTENTS OF RIGHT HALF OF SPECIFIED AC IN OCTAL
	%Q		;CONTENTS OF AC IN DECIMAL
	%R		;DIRECTORY NAME FOR DIR # IN AC
	%S		;FILE NAME FOR JFN IN AC
	%T		;CONTENTS OF AC AS PERCENTAGE OF UP TIME
	%U		;DECIMAL BIT NUMBERS, SEPARATED BY COMMAS
	%V		;CPU TIME WITH TENTHS OF SECONDS
	%W		;TYPE TEXT POINTED BY AC IF POINTER LEGAL
	%X		;TYPE ILLEG INST ERROR MSG
	%Y		;RETYPE COMMAND LINE, A LA ^R
	%Z		;TYPE KEYWORDS IN TABLE AC POINTS TO

;UNRECOGNIZED %-CODE

UN%:	SUB	P,[XWD	1,1]	;FORGET RETURN
	POP	P,A		;RECOVER TEXT POINTER
	TYPE	<%>		;DIGIT, IF ANY, IS LOST.
	JRST	ETYP2A		;CONTINUE  STARTING WITH CHAR AFTER %

;%ETYPE...
;ROUTINES FOR LETTERS AFTER %.
;THESE ROUTINES RECEIVE IN C: CONTENTS OF SPECIFIED AC, OR 0 IF NONE.
;THEY MAY CLOBBER AC'S A, B, C, AND D ONLY.

;CURRENT TIME

%A:	GTAD			;GET CURRENT DATE & TIME
A1:	HRLZI C,B0+B10+B17	;NO DATE, NO SECONDS. 24-HR TIME.
A2:	MOVE B,A
	MOVE A,COJFN
	CAMN B,[-1]		;DOES SYSTEM HAVE DATE & TIME?
	HRLZI B,1		;CHANGE TO CALL SCREWUP ________
	ODTIM
	RET

;CPU TIME USED. ALSO SEE %V.

%B:	HRROI A,-5		;SAY WHOLE JOB
	RUNTM
%B1:	IDIV A,B		;CONVERT TO SECS
	JRST TOUT		;TYPE AS H:MM:SS

;CONSOLE TIME USED

%C:	HRROI A,-5
	RUNTM
	MOVE A,C
	JRST %B1

;DATE

%D:	SKIPN A,C		;USE GIVEN QUANTITY IF ANY
	GTAD			;GET CURRENT DATE & TIME FROM SYSTEM
	MOVEM A,%EDAYT		;SAVE FOR %E
	HRLZI C,B9+B17		;DATE ONLY, STANDARD CONCISE FORMAT
	JRST A2			;GO PRINT DATE

;SAME TIME AS LAST %D, TO AVOID INCONSISTENCIES AT MIDNITE.

%E:	SKIPN	A,C		;SEE IF AN AC SPECIFIED
	MOVE A,%EDAYT		;NO, GET SAVED TIME
	JRST A1			;SEE %A

;ETYPE'S % ROUTINES ...

;TYPE "FORK N" OR "FORKNAME (N)"
; GET FORK HANDLE FROM INDICATED AC, OR IF NONE, CELL "CIFORK".

%F:	SKIPG B,C
	MOVE B,CIFORK		;ELSE USE CURRENT FORK
	JUMPL B,[RET]		;NO FORK (CAN THIS HAPPEN?)
	TRZ B,.FH
	MOVE A,FKFLG(B)
	TLNN A,FK%NAM		;DOES IT HAVE A NAME
	JRST %F1		;NO. TYPE NUMBER
	MOVEI A,SYMLTH		;NAME STRING LENGTH
	IMULI A,(B)
	UTYPE FKNAM(A)		;YES TYPE NAME
	PRINT "("
	CALL TOCT
	PRINT ")"
	RET

%F1:	TYPE <Fork >
	JRST TOCT		;OCTAL OUTPUT FROM B


;DEVICE NAME FOR DESIGNATOR IN INDCATED AC.

%H:	MOVE A,C
	DVCHR		;TRANSLATE JFN (IF GIVEN) TO DEVICE DESIGNATOR
	MOVE B,A
	MOVE A,COJFN
	DEVST		;DEVICE TO STRING
	 CALL JERR
	RET

;NUMBER OF USERS ON SYSTEM.
;COUNTS NUMBER OF POSITIVE ENTRIES IN SYSTEM TABLE 1.

%I:	SETZ B,			;COUNTER
	SETO D,			;TABLE WORD -1 IS LENGTH
	GTB 1
	HRLZ D,A		;SET UP LOOP COUNTER/TABLE INDEX
%I1:	GTB 1			;TABLE 1 IS POSITIVE IF JOB EXISTS
	JUMPL A,%I3
	GTB 3			;TABLE 3 ENTRY RH IS 0 IF NOT LOGGED IN
	TRNE A,-1		;OMIT UNLOGGEDIN USERS FROM COUNT
	AOS B
%I3:	AOBJN D,%I1
	JUMPE B,[UTYPE [ASCIZ /No jobs/]
		RET]
	CAIN B,1
	 JRST [	UTYPE [ASCIZ /One job/]
		RET]
	MOVE A,COJFN
	MOVEI C,^D10
	NOUT			;PRINT NUMBER
	 CALL JERRC		;ERROR NUMBER IN C
	CAIL B,^D25
	PRINT "!"
	SUBI B,^D25
	JUMPG B,.-3
	TYPE < Jobs>
	RET

;UPTIME

%K:	TIME			;TIME SINCE SYSTEM RESTARTED
	IDIV A,B		;CONVERT TO SECONDS
	CALL TOUT		;PRINT AS HH:MM:SS
	CAML A,[6*^D50*^D3600]	;NO MORE THAN 6 !S
	MOVE A,[6*^D50*^D3600]	;TO PROTECT 72 CHAR TERMS
	CAIL A,^D50*^D3600
	PRINT "!"
	SUBI A,^D50*^D3600	;SHORTEN UPTIME BY 50 HOURS
	JUMPG A,.-3		;AND EXCLAIM SOME MORE IF NEEDED
	RET

;ETYPE'S % ROUTINES ...

;"TTY N" OR "DETACHED"

%L:	GJINF
	JUMPL D,[UTYPE [ASCIZ /Detached/]
		RET]
	TYPE <TTY>;
	MOVE A,COJFN
	MOVE B,D
	JRST TOCT		;TYPE OCTAL FROM B

;ACCOUNT
;TAKES 5B2+NUMBER, OR STRING POINTER, IN INDICATED AC, AS LOGIN.

%M:	MOVE A,COJFN
	LDB B,[POINT 3,C,2]
	CAIE B,5
	JRST [	MOVE B,C
		SETZ C,
		SOUT
		RET]
	MOVE B,C
	TLZ B,700000
	MOVEI C,^D10
	NOUT
	 CALL JERRC
	RET

;NAME OF CONNECTED DIRECTORY. MUST PRECEDE %N.

%G:	GJINF
	MOVE	C,B
	JRST	%R

;USER (DIRECTORY) NAME LOGGED IN UNDER.

%N:	GJINF
	MOVE	C,A		;LOGIN DIRECTORY NO
	JRST	%R

;ETYPE'S % ROUTINES...

;OCTAL NUMBER IN SPECIFIED AC.

%O:	MOVE B,C
	JRST TOCT		;TYPE OCTAL FROM B

;18 BIT OCTAL NUMBER FROM RIGHT HALF OF SPECIFIED AC

%P:	HRRZ B,C
	JRST TOCT

;TSS JOB NUMBER. MUST PRECEDE %Q.

%J:	GJINF			;GETS JOB # IN C

;FLOATING PT OR DECIMAL NUMBER FROM AC.
;PRINT AS FLOATING IF NORMALIZED AND WITH EXPONENT 100<E<377

%Q:	MOVE B,C
	MOVM C,B
	TLNE C,700000		;EXPONENT .GE. 100?
	TLNN C,400		;NORMALIZED?
	JRST %Q1		;NO, PRINT DECIMAL
	CAMGE C,[1.0E5]		;CAN ACCOMMODATE FIXED POINT?
	 JRST %Q2		;YES, DON'T USE FLOUT
	MOVEI A,3		;MIN NUMBER OF COLUMNS FOR FIELD 1
	CAMGE C,[100.0]		;FIND RANGE OF NUMBER
	JRST .+3
	FDVRI C,(10.0)		;REDUCE NUMBER
	AOJA A,.-3		;COUNT ONE MORE PLACE FOR FIELD 1
	MOVE C,[1B4+1B6+2B29]	;POINT AND AT LEAST ONE DIG TO LEFT
	DPB A,[POINT 6,C,23]	;AND 2 DIG AFTER PT
	MOVE A,COJFN
	FLOUT
	CALL JERRC
	RET

;HERE TO DO OUR OWN FLOATING OUTPUT RATHER THAN CALLING FLOUT
%Q2:	FMPRI C,(100.0)		;WANT TWO DIGITS PAST DECIMAL POINT
	FADRI C,(0.5)		;ROUND
	MULI C,400		;CONVERT TO INTEGER
	ASH D,-243(C)
	SKIPL B			;CORRECT SIGN
	SKIPA C,D
	MOVN C,D
	IDIVI C,^D100		;GET INTEGER PART
	PRINT " "		;ALWAYS ONE LEADING BLANK
	MOVE B,C		;PRINT INTEGER PART
	CALL %Q1
	PRINT "."
	MOVM B,D
	SKIPA C,[1B2+1B3+2B17+^D10]
%Q1:	MOVEI C,^D10
	MOVE A,COJFN
	NOUT
	 CALL JERRC
	RET

;FLOAT THE INTEGER IN A

FLOAT::	IDIVI A,400000		;BREAK NUMBER INTO TWO PARTS
	FSC A,254		;CONVERT HIGH PART
	FSC B,233		;CONVERT LOW PART
	FADR A,B		;COMBINE PARTS
	RET

;DIRECTORY NAME FOR NUMBER IN AC

%R:	MOVE	A,COJFN
	MOVE	B,C
	CALL	$DIRST
	TYPE	<???>
	RET

;FILE NAME FOR JFN IN AC

%S:	MOVE A,COJFN
	MOVE B,C
	SETZ C,
	JFNS
	RET

;CONTENTS OF AC AS PERCENTAGE OF UP TIME

%T:	TIME		;GET UPTIME IN A
	MULI C,^D200
	DIV C,A		;HOPE DIVISORS TO CONVERT TO SECS ARE SAME
	ADDI C,1	;ROUND
	LSH C,-1
	CALL %Q		;PRINT IN DECIMAL
	PRINT "%"
	RET

;ETYPE'S % ROUTINES...

;CONTENTS OF AC AS LIST OF DECIMAL NUMBERS FOR SET BITS,
; OR "NONE" IF AC 0.

%U:	JUMPE C,[UTYPE [ASCIZ /None/]
		RET]
	SETZ D,			;BIT NUMBER
	TLNE C,B0		;FIND FIRST SET BIT
	JRST %U2
	LSH C,1
	AOS D
	JRST .-4		;LOOP FOR SUCCESSIVE BITS

%U1:	TLNN C,B0
	JRST %U3
	PRINT ","		;COMMA (AND SPACE) BEFORE ALL BUT FIRST
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)
	CAIL B,^D65
	PRINT EOL		;EOL IF TOO FAR RIGHT
	PRINT " "
%U2:	ETYPE <%4Q>		;BIT # IN DECIMAL
%U3:	AOS D
	LSH C,1
	JUMPN C,%U1
	RET

;CPU TIME USED, INCLUDING TENTHS OF SECONDS, FOR ^T FOR DGB.

%V:
	SKIPG	A,C		;PASSED HANDLE?
	HRROI A,-5		;SAY WHOLE JOB
	RUNTM
	MOVE C,B		;TICKS PER SECOND
	IDIV A,B		;CONVERT TIME IN TICKS TO SECS
	CALL TOUT		;TYPE H:MM:SS
	IDIVI C,^D10		;GET TICKS PER 1/10 SEC
	JUMPN D,[RET]		;NOT EVEN, DON'T PRINT TENTHS OF SECS
	IDIV B,C		;CONVERT REMAINDER OF TICKS TO TENTHS
	ETYPE <.%2Q>;		;TYPE TENTHS OF SECONDS
	RET

;TEXT POINTED TO IF LEGAL POINTER

%W:
	HLRZ A,C
	CAIE A,-1
	CAIN A,<POINT 7,0>B53
	CAIA
	RET
	HRLI C,<UETYPE>B53
	PUSH P,C		;SAVE BUILT ETYPE FOR EXECUTION
	MOVE A,-6(P)
	MOVE B,-5(P)
	MOVE C,-4(P)
	MOVE D,-3(P)		;RESTORE AC'S TO PROPER STATE
	XCT 0(P)
	POP P,C
	RET

;ETYPE'S % ROUTINES...

;TYPE VALUE OF ILLEGAL INSTRUCTION, " AT" PC, AND,
; IF ILLEG INSTRUCTION WAS A JSYS, A SYSTEM ERROR MESSAGE.
; C/ FORK HANDLE,,PC
;USED IN A MESSAGE IN TABLE "WHY" THAT IS USED BY "START", "RUNSTAT", ^T

%X:	SETZB B,D		;SAY HAVEN'T GOT INSTRUCTION YET
	MOVEI A,-1(C)		;MASK PC AND SUBTRACT 1
	TLNN C,-1		;CHECK FOR FORK HANDLE
	JRST %X3
%X1:
	PUSH P,FORK
	HLRZM C,FORK		;USE PASSED FORK HANDLE
	CALL MAPPF		;MAP PAGE OF FORK INTO BUFFER "PAGEN"
	POP P,FORK		;RESTORE FORK
	TLNE A,B5		;NO SUCH PAGE (SHOULDN'T OCCUR)
	TLNN A,B2
	JRST %X3		;READ PROTECTED, FORGET IT
	ANDI A,777		;MASK ADDRESS WITHIN PAGE
	JUMPN D,.+2		;JUMP IF TRACING AN XCT
	MOVE D,PAGEN(A)		;PICK UP INST 1ST TIME THROUGH
	HLRZ B,PAGEN(A)		;FETCH LH OF INST THAT FAILED
	TRZ B,740		;IGNORE AC FIELD 
	CAIN B,<XCT>B53		;TRACE SIMPLE XCT'S.
				;DON'T HANDLE INDEXING OR
				;INDIRECT ADDRESSING.
	JRST [	MOVEI A,@PAGEN(A)	;GET EFF ADDR
		JRST %X1]		;GO BACK AND GET ADDRESSED WORD
	ETYPE <%4O >		;TYPE INSTRUCTION
%X3:	ETYPE <at %3P>		;PC
	CAIE B,<JSYS>B53
	JRST %X9		;NOT A JSYS, DONE
	TYPE < - JSYS error:
  >;
	SKIPL A,LFORK		;GET ERROR CODE NOW FOR ERSTR ERR RET
	CALL $GETER		;DO GETER JSYS, PRESERVING 4-10
	MOVE A,COJFN
	SETZ C,
	ERSTR			;PRINT SYSTEM ERR MSG FOR CODE IN B
	 JRST [	UETYPE [ASCIZ /Error message not found for error %2P/]
		JRST .+2]	;R1: BAD ERROR NUMBER
	JRST .+1		;R2: DESTINATION PROBLEM, FORGET IT.
%X9:	SETO A,
	JRST MAPPF		;UNMAP PAGE THEN RETURN

;ETYPE'S % ROUTINES...

;RETYPE CURRENT COMMAND INPUT LINE

%Y:	PRINT EOL
	PRINT " "
	MOVE B,BFP
	IDPB C,B		;TERMINATE WITH NULL: ASSUME C 0.
	UTYPE CBUF
	RET

;LIST ALL KEYWORDS IN TABLE AC POINTS TO

%Z:	SKIPN A,(C)		;PICK UP TABLE COUNT
	RET			;NULL TABLE
%Z1:	AOS C			;STEP TABLE POINTER
	CALL PRVCK		;CHECK TO SEE IF IT SHOULD BE PRINTED
	 JRST %Z2		; NO.
	HLRZ B,(C)		;LH OF TABLE WORD POINTS TO...
	MOVE B,(B)		;VALUE WORD
	TLNE B,INVIS
	JRST %Z2		;DON'T PRINT IF "INVISIBLE"
	MOVE B,(C)		;RH OF TABLE WORD POINTS TO TEXT
	CALL COMSPC		;Space to proper column
	UTYPE (B)
%Z2:	SOJG A,%Z1		;ENDTEST AND LOOP
	PRINT EOL
	RET


COMSPC:	PUSH P,A
	PUSH P,B
	MOVE A,COJFN
	RFPOS			;GET POSITION
	MOVEI A,(B)		;HORIZONTAL ONLY
	CAILE A,14*5		;TOO FAR?
	JRST [	PRINT EOL
		SETZ B,
		JRST COMSP1]
	IDIVI A,14		;TWELVE SPACES/COMMAND
	JUMPE B,COMSP1
	SUBI B,14
COMSP1:	PRINT SPACE
	AOJLE B,COMSP1
	POP P,B
	POP P,A
	RET

;SUBROUTINE TO TYPE NUMBER OF SECONDS IN A IN THE FORM H:MM:SS.
;HOURS ARE SUPPRESSED IF ZERO

TOUT::	PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVEI C,^D10		;SET RADIX, NO LEADING ZEROES
	IDIVI A,^D3600		;COMPUTE HOURS
	PUSH P,B		;SAVE REMAINDER
	SKIPE A			;DON'T PRINT IF ZERO HOURS
	 CALL TOUT1		;PRINT HOURS
	POP P,A			;RESTORE REMAINDER
	IDIVI A,^D60		;COMPUTE MINUTES
	PUSH P,B		;SAVE SECONDS
	CALL TOUT1		;PRINT MINUTES
	POP P,A			;RESTORE SECONDS
	CALL TOUT1		;PRINT SECONDS
	POP P,C
	POP P,B
	POP P,A
	RET


;INTERNAL ROUTINE TO PRINT NUMBER IN A

TOUT1:	MOVE B,A
	MOVE A,COJFN
	TLNE C,-1		;PRINTING FIRST FIELD OF TIME?
	 PRINT ":"		;NO
	NOUT
	 CALL JERRC
	HRLI C,(1B2!1B3!2B17)	;SET TO PRINT 2 COLS, LEADING ZEROS
	RET			;ON NEXT CALL

; UNMAP ALL USELESS PRIVATE PAGES
;  CALLED BY ERROR (^C), AND "RESET"


UNMAP::	MOVE A,[400000,,<BPBUF>/1000]
UNMAP1:	CAMLE A,[400000,,<EPBUF>/1000]
	RET
	RPACS
	TLNN B,(1B5)
	AOJA A,UNMAP1
	MOVE B,A
	SETO A,
	SETZ C,
	PMAP
	AOS A,B
	JRST UNMAP1

;$DIRST	FANCY DIRST -- CASE NAMES

$DIRST::;AC'S ARE THE SAME AS THE ORIGINAL
	PUSH	P,B
	PUSH	P,A
	ADD	P,[10,,10]
	JUMPGE	P,DIRST4	;NO ROOM
	HRROI	A,-7(P)		;STRING POINTER TO STACK
	DIRST
	JRST [	MOVE	A,-10(P)
		JRST	DIRST5]
	PUSH	P,C
NOIAC <	MOVE	B,[POINT 7,-10(P)]	;STACK STRING
	MOVEI	C,1		;NO CASE THE FIRST LETTER
DIRST1:	ILDB	A,B
	CAIL	A,"A"
	CAILE	A,"Z"
	TROA	C,1		;NOT LETTER
	TRZE	C,1		;LETTER -- ONLY CASE IF PREVIOUS IS ALSO
	JRST	.+2		;NOT LETTER OR FIRST LETTER!
	ADDI	A,40		;MAKE LOWER CASE
	DPB	A,B		;CASE THE STRING IN STACK
	JUMPN	A,DIRST1
> ; END NOIAC
IAC <	MOVEI	A,-10(P)
	HRLI	A,440700 ; GOTTA DO IT HARD WAY CAUSE LOWER AINT SO SMART
	CALL	LOWER##	; SUPER-FANCY LOWERCASE ROUTINE IN LOWER.MAC
>
	MOVE	A,-11(P)	;ORIGINAL A
	HRROI	B,-10(P)
	SETZ	C,
	SOUT
DIRST2:	POP	P,C
	AOS	-12(P)
	JRST	DIRST5
DIRST4:	AOS	-12(P)		;NO ROOM IN STACK JUST DO IT
	DIRST
	SOS	-12(P)		;FAILED -- NO SKIP
DIRST5:	SUB	P,[11,,11]
	POP	P,B		;ALWAYS RESTORE B
	RET

;$SYSGT  SIMULATES A SYSGT JSYS BY TRYING A HASH LOOKUP IN A LOCAL TABLE
;  FIRST, AND THEN THE SYSTEM IF IT IS NOT IN THE TABLE.  NOTE
;  THE SYSTEM DOES A (SLOW) LINEAR SEARCH PLUS CONTEXT SWITCHES.

;  AC'S AT ENTRY AND EXIT ARE EXACTLY THOSE OF SYSGT

$SYSGT::PUSH P,C		;SAVE FOR CALLER
	PUSH P,A		;SIXBIT OF TABLE NAME
	MOVEI C,SGTBLN		;COUNT THIS MANY PROBES (TABLE FULLNESS)
	TSC A,A
	LSH A,-1		;FAST HASH IS BETTER THAN BURNED CYCLES
	IDIVI A,SGTBLN		;ON A BIG TABLE, AT LEAST.

SYSGT1:	SKIPN A,SGTNAM(B)	;GET NAME FROM HASH TABLE
	 JRST SYSGT2		;HIT A 0 -- TRY THE SYSTEM
	CAMN A,0(P)		;IS THIS THE ONE WE ARE LOOKING FOR?
	 JRST SYSGT3		;YES, USE IT.
	SOSGE B			;DO LINEAR SEARCH BACKWARDS
	MOVEI B,SGTBLN-1	;RING THE POINTER
	SOJG C,SYSGT1		;BEEN THRU THE WHOLE TABLE?
	CALL SCREWUP		;MAKE SGTBLN BIGGER!!!!

SYSGT2:	PUSH P,B		;SAVE THE INDEX
	MOVE A,-1(P)		;GET BACK THE NAME
	SYSGT			;TRY THE SYSTEM
	JUMPE B,SYSGT4		;OH WELL
	EXCH B,0(P)		;GET BACK INDEX
	POP P,SGTAC2(B)		;INSERT ENTRY INTO HASH TABLE
	MOVEM A,SGTAC1(B)
	POP P,SGTNAM(B)
	MOVE B,SGTAC2(B)
	POP P,C
	RET

SYSGT3:	MOVE A,SGTAC1(B)
	MOVE B,SGTAC2(B)
	SUB P,BHC+1
	POP P,C
	RET

SYSGT4:	SUB P,BHC+2
	POP P,C
	RET

;FLOATING POINT NUMBER INPUT

;PRE-READS STRING IN ORDER TO DO EDITTING AND NOISE

FPIN::	CALL CSTR		;COLLECT A STRING
	CAIN TRM,"."
	 JRST MORE		;GET MORE -- BACK INTO CSTR
	AOS CNT			;MAKE BUFFF INCLUDE THE TERMINATOR
	CALL BUFFF		;BUFFER UP, READY FOR A JSYS CALL
	SOS CNT
	FLIN			;INPUT FLOATING NUMBER FROM BUFFER
	 CALL [	CAIN A,FLINX4	;-.Q  AND OTHER FUNNY FORMATS
		 JRST [	LDB B,A	;GET THE LAST CHARACTER READ
			JUMPE B,[SUB P,BHC+1	;READ IT ALL
				JRST MORE]	;GO BACK INTO CSTR
			JRST CERR]	;DIDN'T USE ALL CHARACTERS
		CAIN C,FLINX1	;BAD FORMAT
		 JRST CERR
		CAIE C,FLINX2	;UNDER FLOW
		CAIN C,FLINX3	;OVER FLOW
		 JRST CERR
		JRST JERRC]	;ANYTHING ELSE BOMBS THE EXEC
	IBP A			;STEP OVER THE NULL
	CAME A,CSBUFP		;FLIN USED THE ENTIRE STRING?
	 JRST CERR		;NO
	MOVE A,B		;HERE IS THE ANSWER
	RET			;CALLER IS TO DO TERM CHK AND CONF

;ASNFRE - assign free space
; A/ number of words,,0
;	CALL ASNFRE
; RET +1; space unavailable
; RET +2; space assigned,
;  A/ number of words,,location

ASNFRE::PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	HLLZ D,A		;Number of words wanted
	NOINT
	CALL ASNFS0		;Attempt assignment
	 JRST ASNFR9
	MOVEM D,-3(P)		;Return assignment
	CALL AFLT		;Record assignment as temporary
	AOS -4(P)		;Successful return
ASNFR9:	OKINT
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET


;RELFRE - release free space
; A/ number of words,,location
;	CALL RELFRE
; RET +1; always

RELFRE::PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE D,A		;Free space being returned
	NOINT
	CALL RFLT		;Release from temporary free list
	CALL RELFS0		;Do the work
	JRST ASNFR9


;KEPFRE - keep free space
; A/ number of words,,location
;	CALL KEPFRE
; RET+1; always

KEPFRE::PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE D,A
	NOINT
	CALL RFLT
	JRST ASNFR9

;ASNPAG - assign whole consecutive page(s) of storage
; A/ number of pages,,0
;	CALL ASNPAG
; RET +1; pages unavailable
; RET +2; page(s) assigned,
;  A/ number of pages,,page

ASNPAG::PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE D,A
	NOINT
	CALL ASNPG0
	 JRST [	CALL GCFRE	;Try to get pages out of free space
		CALL ASNPG0
		 JRST ASNPA9
		JRST .+1]
	MOVEM D,-3(P)
	CALL AFLT
	AOS -4(P)
ASNPA9:	OKINT
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET


;RELPAG - release whole consecutive page(s) of storage
; A/ number of pages,,first page
;	CALL RELPAG
; RET +1; always

RELPAG::PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE D,A
	NOINT
	CALL RELPG0
	CALL RFLT
	JRST ASNPA9


;GCFRE - try to collect up whole pages in the freespace and release
;  into the free pages

GCFRE:	RET			;Noop for now

;AFLT - append free space to temporary list
; D/ number of words,,location	[number of pages,,page]
;	CALL AFLT
; RET +1; always

AFLT:	SOS A,FSLTX		;Decrement index to next slot
	CAML A,FSLTB		;Still valid
	 JRST [	MOVEM D,0(A)	;Remember free space assignment
		RET]
	PUSH P,D		;List overflow
	HLLZ D,FSLTB		;Assign a new list
	JUMPE D,AFLT1		;If no previous list, setup one
	ASH D,1			; double old list
	CALL ASNFS0		; ..
	 JRST [	POP P,D		; We shouldn't ever fail!?!
		RET]
	MOVEM D,FSLTX		;Set up the index to proper depth
	HLRZ A,FSLTB		; which is beginning of new list
	ADDB A,FSLTX		; plus length of old
	HRL A,FSLTB		;Now construct BLT pointer
	HLRZ B,FSLTB		; to move old list to new
	ADDI B,(A)		; ..
	BLT A,-1(B)		; ..
	EXCH D,FSLTB		;Release old list to free space
	CALL RELFS0		; ..
	POP P,D			;Should now be able to put assignment
	JRST AFLT		; on the list

AFLT1:	MOVSI D,^D8		;Length of initial list
	CALL ASNFS0
	 JRST [	POP P,D		;Forget request if it fails
		RET]
	MOVEM D,FSLTB		;Beginning of list
	ADDI D,^D8		;Initial index
	MOVEM D,FSLTX
	POP P,D
	JRST AFLT


;RFLT - remove free space assignment from temporary list
; D/ number of words,,location	[number of pages,,page]
;	CALL RFLT
; RET +1; always

RFLT:	HLRZ C,FSLTB
	ADD C,FSLTB
RFLT1:	CAMG C,FSLTX		;Search for block
	 RET			;Noop if not found
	CAME D,-1(C)
	SOJA C,RFLT1
	AOS FSLTX		;Remove from list
RFLT2:	CAMG C,FSLTX
	 RET
	MOVE A,-2(C)		;Shuffle list
	MOVEM A,-1(C)
	SOJA C,RFLT2

;RELFLT - release temporary free space
;	CALL RELFLT
; RET +1; always

RELFLT::PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	NOINT
	CALL RLFLT
	OKINT
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET


RLFLT:	HLRZ C,FSLTB		;Compute empty index
	ADD C,FSLTB
	CAMG C,FSLTX		;Empty?
	RET			;Yes
	AOS C,FSLTX		;Remove an entry
	MOVE D,-1(C)		;Pick it up
	TRNE D,777000		;Page or words?
	CALL RELFS0		;Words
	TRNN D,777000
	CALL RELPG0		;Page(s)
	JRST RLFLT

;ASNFS0 - free space assignment (working code)
; D/ number of words,,0
;	CALL ASNFS0
; RET +1; space unavailable
; RET +2; space assigned,
;  D/ number of words,,location

ASNFS0:	TLC D,400000		;Complement high order bit
	HLLO A,FRESPC		;First see if there is
	TLC A,400000		; enuf to satisfy
	CAMG A,D		; the request..
	 JRST ASNFS6		; No, get another page of free storage
	HRLZI C,377777		;C/ best fit so far
	MOVEI B,FRESPC		;B/ previous free block
	HRRZ A,0(B)		;A/ free block location
ASNFS1:	HRR D,A			;Remember location on stack
	HLL A,0(A)		;Pick up size of block
	TLC A,400000		;Complement high order digit for compare
	CAMN A,D		;Exact fit?
	 JRST [	HRRZ C,0(A)	;Take this free block out of chain
		HRRM C,0(B)	; ..
		JRST ASNFS8]
	CAML A,D		;Large enuf?
	CAML A,C		;Yes, will waste least space?
	CAIA			;No, bypass block
	 MOVE C,A		; Yes, remember this block as best fit.
	MOVEI B,(A)		;Step thru chain
	HRRZ A,0(B)		; til block we've just looked at
	JUMPN A,ASNFS1		; doesn't point to another.
	TRNN C,-1		;Did we find a block large enuf?
	 JRST ASNFS6		; No, assign another page of free space
	HLLZ A,D		;Get back amount wanted
	TLC A,400000		; ..
	MOVNS A			;Negate to remove from block count
	ADDB A,0(C)		; ..
	HLR D,A			;We will take our block from the
	ADDI D,(C)		; tail end of this free block
ASNFS8:	AOS 0(P)		;Successful return
	TLC D,400000		;Uncomplement high order bit
	HLLZ A,D		;Get length of block assigned
	MOVNS A			;Negate to remove from total free count
	ADDM A,FRESPC		; ..
ASNFS9:	RET

ASNFS6:	TLC D,400000		;Uncomplement high order bit
	PUSH P,D		;Save word count
	MOVSI D,1		;Ask for one page
	CALL ASNPG0		; ..
	 JRST [	POP P,D		; return as called
		JRST ASNFS9]	; transmit failure to caller
	ASH D,^D9		;Convert page numbers to addresses
	CALL RELFS0		;Release into free space!
	POP P,D
	JRST ASNFS0		;Try again

;RELFS0 - free space release (working code)
; D/ number of words,,location
;	CALL RELFS0
; RET +1; always

RELFS0:	HLLZM D,0(D)		;Store number of words as free block header
	MOVEI B,FRESPC		;B/ previous free block
	CALL RELFS1
	HLLZ A,0(D)		;Update total count of free space
	ADDM A,FRESPC		; ..
	RET

RELFS2:	MOVEI B,(C)		;Block just checked now previous
RELFS1:	HRRZ C,0(B)		;Step to next free block
	CAIG C,(D)		;Is it beyond block being released?
	 JRST [	JUMPN C,RELFS2	;Yes, if not at the end of chain continue scan
		HRRM D,0(B)	;Reached end of chain, append this
		RET]		; to the end.
	PUSH P,C		;Remember block addr beyond
	HLLZS 0(B)		;Remove forward pointer from previous block
	MOVEI C,(D)		;Append block being released
	CALL RELFS3		; to previous block
	POP P,C			;Now connect up with forward block

RELFS3:	HLRZ A,0(B)		;Get length of preceeding block
	ADDI A,(B)		;1st loc after end of preceeding block
	CAIN A,(C)		;Is it 1st loc of block being appended?
	 JRST [	MOVE A,0(C)	;Yes, just add its size into preceeding block
		ADDM A,0(B)	; (if forward block, also sets pointer)
		RET]
	HRRM C,0(B)		;Make previous block point to appended
	MOVEI B,(C)		;Call appended block preceeding
	RET

;ASNPG0 - page assignment (working code)
; D/ number of pages,,0
;	CALL ASNPG0
; RET +1; page(s) unavailable
; RET +2; page(s) assigned,
;  D/ number of pages,,page

ASNPG0:	HLRZS D			;Page count to RH for compares
	MOVSI A,-SFREBT		;Number of words in free page bit table

ASNPG1:	MOVE B,FREBT(A)		;Pick up free page bit mask
ASNPG2:	JFFO B,ASNPG3		;Scan for a 1 bit (free page)
	AOBJN A,ASNPG1		;No good, try next mask word
	HRLZS D			;Page count back to original position
	RET			;We're all out?!

ASNPG3:	PUSH P,C		;Save number of bit found
	MOVNS 0(P)		;Its the base additive number
	MOVN C,BITS(C)		;Turn on all preceeding bits in mask
	IOR B,C			; so that the complement will show
	SETCA B,		; any following 0 bit (in use page)
ASNPG4:	JFFO B,ASNPG5		;A 1 bit here is really a 0 bit (stop)
	MOVEI C,^D36		;Say another 36 consecutive pages
	ADDM C,0(P)		; follow
	AOBJP A,ASNPG5		;Continue scanning bit table
	SETCM B,FREBT(A)	;Get complement of mask so we can search
	JRST ASNPG4		; for 1's (which are really 0's)
ASNPG5:	ADDM C,0(P)		;Stack now has count of consecutive pages
	EXCH C,0(P)		;Switch with bit position of last mask
	CAIL C,(D)		;Enuf pages for request?
	 JRST ASNPG6
	POP P,C			;No, have to continue looking
	MOVN C,BITS(C)		;Get mask for this group (this word)
	IOR B,C			;Fake that these pages are used
	SETCA B,		; and look for next group
	JRST ASNPG2

ASNPG6:	SUBM C,0(P)		;Stack get count of free pages excluding
				; last word.
	MOVEI A,(A)		;Get back position of first free page
	IMULI A,^D36
	SUBB A,0(P)		;First free page
	HRLM D,0(P)		;Save page count for return
	IDIVI A,^D36
	MOVNS B
ASNPG7:	CAIL D,^D36
	SKIPA C,MINUS1		;Mask all bits
	MOVN C,BITS-1(D)	;Reduce mask from left by count
	LSH C,(B)
	ANDCAM C,FREBT(A)
	SUBI D,^D36(B)
	ADDI A,1
	SETZ B,
	JUMPG D,ASNPG7

	POP P,D			;RETURN count,,ffpage
	AOS 0(P)
	RET


;RELPG0 - release page (working code)
; D/ number of pages,,first page
;	CALL RELPG0
; RET +1; always

RELPG0:	HLRZ A,D
	JUMPE A,RELPG9		;Noop if no pages
	ADDI A,-1(D)		;Get last page
	IDIVI A,^D36		;Split into word and bit
	PUSH P,A		;Save last word
	MOVN C,BITS(B)		;Last bit and bits to left
	HRRZ A,D		;First page
	IDIVI A,^D36
	MOVE B,BITS(B)		;Get bit
	LSH B,1			;Bit before first bit
	SOSA B			;First bit and bits to right
RELPG1:	SETO B,			;All bits after first
	CAMN A,0(P)		;Last word?
	AND B,C			;Yes, limit bits
	IORM B,FREBT(A)		;Release these pages
	CAME A,0(P)		;Last page?
	AOJA A,RELPG1		;No, keep going
	SUB P,BHC+1
RELPG9:	RET

MINUS1::-1
ZERO::
BHC::	REPEAT 30,<XWD .-BHC,.-BHC>
BITS::	REPEAT ^D36,<1B<.-BITS>>


	END